34dac92 · text · git.iko.soy

git.iko.soy/text

Implement support for case folding.

--HG-- extra : convert_revision : 37ae006ac0ec6ebeed24109cbc5baa0614540ec6

commit34dac92944113449fdc6ab6977531754eb68c622 authorBryan O'Sullivan <bos@serpentine.com> dateSun 7 Jun 2009, 05:47 (17 years ago) parentb0850d7

8 files changed+486−65

compare with master

unifiedsplit

Data/Text.hs+40−8 Data/Text/Fusion/CaseMapping.hs+237 Data/Text/Fusion/Common.hs+31−2 Data/Text/Lazy.hs+40−8 scripts/Arsec.hs+49 scripts/CaseFolding.hs+42 scripts/CaseMapping.hs+32 scripts/SpecialCasing.hs+15−47

Data/Text.hs+40−8

@@ -56,8 +56,10 @@ module Data.Text

5656 , reverse

5757

5858 -- * Case conversion

59− , toUpper

59+ -- $case

60+ , toCaseFold

6061 , toLower

62+ , toUpper

6163

6264 -- * Folds

6365 , foldl

@@ -385,13 +387,35 @@ reverse :: Text -> Text

385387reverse t = S.reverse (stream t)

386388{-# INLINE reverse #-}

387389

388−-- | /O(n)/ Convert a string to upper case, using simple case

389−-- conversion. The result string may be longer than the input string.

390−-- For instance, the German eszett (U+00DF) maps to the two-letter

391−-- sequence SS.

392−toUpper :: Text -> Text

393−toUpper t = unstream (S.toUpper (stream t))

394−{-# INLINE toUpper #-}

390+-- ----------------------------------------------------------------------------

391+-- ** Case conversions (folds)

392+

393+-- $case

394+--

395+-- With Unicode text, it is incorrect to use combinators like @map

396+-- toUpper@ to case convert each character of a string individually.

397+-- Instead, use the whole-string case conversion functions from this

398+-- module. For correctness in different writing systems, these

399+-- functions may map one input character to two or three output

400+-- characters.

401+

402+-- | /O(n)/ Convert a string to folded case. This function is mainly

403+-- useful for performing caseless (or case insensitive) string

404+-- comparisons.

405+--

406+-- A string @x@ is a caseless match for a string @y@ if and only if:

407+--

408+-- @toCaseFold x == toCaseFold y@

409+--

410+-- The result string may be longer than the input string, and may

411+-- differ from applying 'toLower' to the input string. For instance,

412+-- the Armenian small ligature men now (U+FB13) is case folded to the

413+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is

414+-- case folded to the Greek small letter letter mu (U+03BC) instead of

415+-- itself.

416+toCaseFold :: Text -> Text

417+toCaseFold t = unstream (S.toCaseFold (stream t))

418+{-# INLINE [0] toCaseFold #-}

395419

396420-- | /O(n)/ Convert a string to lower case, using simple case

397421-- conversion. The result string may be longer than the input string.

@@ -402,6 +426,14 @@ toLower :: Text -> Text

402426toLower t = unstream (S.toLower (stream t))

403427{-# INLINE toLower #-}

404428

429+-- | /O(n)/ Convert a string to upper case, using simple case

430+-- conversion. The result string may be longer than the input string.

431+-- For instance, the German eszett (U+00DF) maps to the two-letter

432+-- sequence SS.

433+toUpper :: Text -> Text

434+toUpper t = unstream (S.toUpper (stream t))

435+{-# INLINE toUpper #-}

436+

405437-- | /O(n)/ The 'transpose' function transposes the rows and columns

406438-- of its 'Text' argument. Note that this function uses 'pack',

407439-- 'unpack', and the list version of transpose, and is thus not very

Data/Text/Fusion/CaseMapping.hs+237

@@ -217,3 +217,240 @@ lowerMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char

217217-- LATIN CAPITAL LETTER I WITH DOT ABOVE

218218lowerMapping '\x0130' s = Yield '\x0069' (s :!: '\x0307' :!: '\x0000')

219219lowerMapping c s = Yield (toLower c) (s :!: '\0' :!: '\0')

220+foldMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char

221+{-# INLINE foldMapping #-}

222+-- MICRO SIGN

223+foldMapping '\x00b5' s = Yield '\x03bc' (s :!: '\x0000' :!: '\x0000')

224+-- LATIN SMALL LETTER SHARP S

225+foldMapping '\x00df' s = Yield '\x0073' (s :!: '\x0073' :!: '\x0000')

226+-- LATIN CAPITAL LETTER I WITH DOT ABOVE

227+foldMapping '\x0130' s = Yield '\x0069' (s :!: '\x0307' :!: '\x0000')

228+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

229+foldMapping '\x0149' s = Yield '\x02bc' (s :!: '\x006e' :!: '\x0000')

230+-- LATIN SMALL LETTER LONG S

231+foldMapping '\x017f' s = Yield '\x0073' (s :!: '\x0000' :!: '\x0000')

232+-- LATIN SMALL LETTER J WITH CARON

233+foldMapping '\x01f0' s = Yield '\x006a' (s :!: '\x030c' :!: '\x0000')

234+-- COMBINING GREEK YPOGEGRAMMENI

235+foldMapping '\x0345' s = Yield '\x03b9' (s :!: '\x0000' :!: '\x0000')

236+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND TONOS

237+foldMapping '\x0390' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0301')

238+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND TONOS

239+foldMapping '\x03b0' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0301')

240+-- GREEK SMALL LETTER FINAL SIGMA

241+foldMapping '\x03c2' s = Yield '\x03c3' (s :!: '\x0000' :!: '\x0000')

242+-- GREEK BETA SYMBOL

243+foldMapping '\x03d0' s = Yield '\x03b2' (s :!: '\x0000' :!: '\x0000')

244+-- GREEK THETA SYMBOL

245+foldMapping '\x03d1' s = Yield '\x03b8' (s :!: '\x0000' :!: '\x0000')

246+-- GREEK PHI SYMBOL

247+foldMapping '\x03d5' s = Yield '\x03c6' (s :!: '\x0000' :!: '\x0000')

248+-- GREEK PI SYMBOL

249+foldMapping '\x03d6' s = Yield '\x03c0' (s :!: '\x0000' :!: '\x0000')

250+-- GREEK KAPPA SYMBOL

251+foldMapping '\x03f0' s = Yield '\x03ba' (s :!: '\x0000' :!: '\x0000')

252+-- GREEK RHO SYMBOL

253+foldMapping '\x03f1' s = Yield '\x03c1' (s :!: '\x0000' :!: '\x0000')

254+-- GREEK LUNATE EPSILON SYMBOL

255+foldMapping '\x03f5' s = Yield '\x03b5' (s :!: '\x0000' :!: '\x0000')

256+-- ARMENIAN SMALL LIGATURE ECH YIWN

257+foldMapping '\x0587' s = Yield '\x0565' (s :!: '\x0582' :!: '\x0000')

258+-- LATIN SMALL LETTER H WITH LINE BELOW

259+foldMapping '\x1e96' s = Yield '\x0068' (s :!: '\x0331' :!: '\x0000')

260+-- LATIN SMALL LETTER T WITH DIAERESIS

261+foldMapping '\x1e97' s = Yield '\x0074' (s :!: '\x0308' :!: '\x0000')

262+-- LATIN SMALL LETTER W WITH RING ABOVE

263+foldMapping '\x1e98' s = Yield '\x0077' (s :!: '\x030a' :!: '\x0000')

264+-- LATIN SMALL LETTER Y WITH RING ABOVE

265+foldMapping '\x1e99' s = Yield '\x0079' (s :!: '\x030a' :!: '\x0000')

266+-- LATIN SMALL LETTER A WITH RIGHT HALF RING

267+foldMapping '\x1e9a' s = Yield '\x0061' (s :!: '\x02be' :!: '\x0000')

268+-- LATIN SMALL LETTER LONG S WITH DOT ABOVE

269+foldMapping '\x1e9b' s = Yield '\x1e61' (s :!: '\x0000' :!: '\x0000')

270+-- LATIN CAPITAL LETTER SHARP S

271+foldMapping '\x1e9e' s = Yield '\x0073' (s :!: '\x0073' :!: '\x0000')

272+-- GREEK SMALL LETTER UPSILON WITH PSILI

273+foldMapping '\x1f50' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0000')

274+-- GREEK SMALL LETTER UPSILON WITH PSILI AND VARIA

275+foldMapping '\x1f52' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0300')

276+-- GREEK SMALL LETTER UPSILON WITH PSILI AND OXIA

277+foldMapping '\x1f54' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0301')

278+-- GREEK SMALL LETTER UPSILON WITH PSILI AND PERISPOMENI

279+foldMapping '\x1f56' s = Yield '\x03c5' (s :!: '\x0313' :!: '\x0342')

280+-- GREEK SMALL LETTER ALPHA WITH PSILI AND YPOGEGRAMMENI

281+foldMapping '\x1f80' s = Yield '\x1f00' (s :!: '\x03b9' :!: '\x0000')

282+-- GREEK SMALL LETTER ALPHA WITH DASIA AND YPOGEGRAMMENI

283+foldMapping '\x1f81' s = Yield '\x1f01' (s :!: '\x03b9' :!: '\x0000')

284+-- GREEK SMALL LETTER ALPHA WITH PSILI AND VARIA AND YPOGEGRAMMENI

285+foldMapping '\x1f82' s = Yield '\x1f02' (s :!: '\x03b9' :!: '\x0000')

286+-- GREEK SMALL LETTER ALPHA WITH DASIA AND VARIA AND YPOGEGRAMMENI

287+foldMapping '\x1f83' s = Yield '\x1f03' (s :!: '\x03b9' :!: '\x0000')

288+-- GREEK SMALL LETTER ALPHA WITH PSILI AND OXIA AND YPOGEGRAMMENI

289+foldMapping '\x1f84' s = Yield '\x1f04' (s :!: '\x03b9' :!: '\x0000')

290+-- GREEK SMALL LETTER ALPHA WITH DASIA AND OXIA AND YPOGEGRAMMENI

291+foldMapping '\x1f85' s = Yield '\x1f05' (s :!: '\x03b9' :!: '\x0000')

292+-- GREEK SMALL LETTER ALPHA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

293+foldMapping '\x1f86' s = Yield '\x1f06' (s :!: '\x03b9' :!: '\x0000')

294+-- GREEK SMALL LETTER ALPHA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

295+foldMapping '\x1f87' s = Yield '\x1f07' (s :!: '\x03b9' :!: '\x0000')

296+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PROSGEGRAMMENI

297+foldMapping '\x1f88' s = Yield '\x1f00' (s :!: '\x03b9' :!: '\x0000')

298+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PROSGEGRAMMENI

299+foldMapping '\x1f89' s = Yield '\x1f01' (s :!: '\x03b9' :!: '\x0000')

300+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND VARIA AND PROSGEGRAMMENI

301+foldMapping '\x1f8a' s = Yield '\x1f02' (s :!: '\x03b9' :!: '\x0000')

302+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND VARIA AND PROSGEGRAMMENI

303+foldMapping '\x1f8b' s = Yield '\x1f03' (s :!: '\x03b9' :!: '\x0000')

304+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND OXIA AND PROSGEGRAMMENI

305+foldMapping '\x1f8c' s = Yield '\x1f04' (s :!: '\x03b9' :!: '\x0000')

306+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND OXIA AND PROSGEGRAMMENI

307+foldMapping '\x1f8d' s = Yield '\x1f05' (s :!: '\x03b9' :!: '\x0000')

308+-- GREEK CAPITAL LETTER ALPHA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

309+foldMapping '\x1f8e' s = Yield '\x1f06' (s :!: '\x03b9' :!: '\x0000')

310+-- GREEK CAPITAL LETTER ALPHA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

311+foldMapping '\x1f8f' s = Yield '\x1f07' (s :!: '\x03b9' :!: '\x0000')

312+-- GREEK SMALL LETTER ETA WITH PSILI AND YPOGEGRAMMENI

313+foldMapping '\x1f90' s = Yield '\x1f20' (s :!: '\x03b9' :!: '\x0000')

314+-- GREEK SMALL LETTER ETA WITH DASIA AND YPOGEGRAMMENI

315+foldMapping '\x1f91' s = Yield '\x1f21' (s :!: '\x03b9' :!: '\x0000')

316+-- GREEK SMALL LETTER ETA WITH PSILI AND VARIA AND YPOGEGRAMMENI

317+foldMapping '\x1f92' s = Yield '\x1f22' (s :!: '\x03b9' :!: '\x0000')

318+-- GREEK SMALL LETTER ETA WITH DASIA AND VARIA AND YPOGEGRAMMENI

319+foldMapping '\x1f93' s = Yield '\x1f23' (s :!: '\x03b9' :!: '\x0000')

320+-- GREEK SMALL LETTER ETA WITH PSILI AND OXIA AND YPOGEGRAMMENI

321+foldMapping '\x1f94' s = Yield '\x1f24' (s :!: '\x03b9' :!: '\x0000')

322+-- GREEK SMALL LETTER ETA WITH DASIA AND OXIA AND YPOGEGRAMMENI

323+foldMapping '\x1f95' s = Yield '\x1f25' (s :!: '\x03b9' :!: '\x0000')

324+-- GREEK SMALL LETTER ETA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

325+foldMapping '\x1f96' s = Yield '\x1f26' (s :!: '\x03b9' :!: '\x0000')

326+-- GREEK SMALL LETTER ETA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

327+foldMapping '\x1f97' s = Yield '\x1f27' (s :!: '\x03b9' :!: '\x0000')

328+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PROSGEGRAMMENI

329+foldMapping '\x1f98' s = Yield '\x1f20' (s :!: '\x03b9' :!: '\x0000')

330+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PROSGEGRAMMENI

331+foldMapping '\x1f99' s = Yield '\x1f21' (s :!: '\x03b9' :!: '\x0000')

332+-- GREEK CAPITAL LETTER ETA WITH PSILI AND VARIA AND PROSGEGRAMMENI

333+foldMapping '\x1f9a' s = Yield '\x1f22' (s :!: '\x03b9' :!: '\x0000')

334+-- GREEK CAPITAL LETTER ETA WITH DASIA AND VARIA AND PROSGEGRAMMENI

335+foldMapping '\x1f9b' s = Yield '\x1f23' (s :!: '\x03b9' :!: '\x0000')

336+-- GREEK CAPITAL LETTER ETA WITH PSILI AND OXIA AND PROSGEGRAMMENI

337+foldMapping '\x1f9c' s = Yield '\x1f24' (s :!: '\x03b9' :!: '\x0000')

338+-- GREEK CAPITAL LETTER ETA WITH DASIA AND OXIA AND PROSGEGRAMMENI

339+foldMapping '\x1f9d' s = Yield '\x1f25' (s :!: '\x03b9' :!: '\x0000')

340+-- GREEK CAPITAL LETTER ETA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

341+foldMapping '\x1f9e' s = Yield '\x1f26' (s :!: '\x03b9' :!: '\x0000')

342+-- GREEK CAPITAL LETTER ETA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

343+foldMapping '\x1f9f' s = Yield '\x1f27' (s :!: '\x03b9' :!: '\x0000')

344+-- GREEK SMALL LETTER OMEGA WITH PSILI AND YPOGEGRAMMENI

345+foldMapping '\x1fa0' s = Yield '\x1f60' (s :!: '\x03b9' :!: '\x0000')

346+-- GREEK SMALL LETTER OMEGA WITH DASIA AND YPOGEGRAMMENI

347+foldMapping '\x1fa1' s = Yield '\x1f61' (s :!: '\x03b9' :!: '\x0000')

348+-- GREEK SMALL LETTER OMEGA WITH PSILI AND VARIA AND YPOGEGRAMMENI

349+foldMapping '\x1fa2' s = Yield '\x1f62' (s :!: '\x03b9' :!: '\x0000')

350+-- GREEK SMALL LETTER OMEGA WITH DASIA AND VARIA AND YPOGEGRAMMENI

351+foldMapping '\x1fa3' s = Yield '\x1f63' (s :!: '\x03b9' :!: '\x0000')

352+-- GREEK SMALL LETTER OMEGA WITH PSILI AND OXIA AND YPOGEGRAMMENI

353+foldMapping '\x1fa4' s = Yield '\x1f64' (s :!: '\x03b9' :!: '\x0000')

354+-- GREEK SMALL LETTER OMEGA WITH DASIA AND OXIA AND YPOGEGRAMMENI

355+foldMapping '\x1fa5' s = Yield '\x1f65' (s :!: '\x03b9' :!: '\x0000')

356+-- GREEK SMALL LETTER OMEGA WITH PSILI AND PERISPOMENI AND YPOGEGRAMMENI

357+foldMapping '\x1fa6' s = Yield '\x1f66' (s :!: '\x03b9' :!: '\x0000')

358+-- GREEK SMALL LETTER OMEGA WITH DASIA AND PERISPOMENI AND YPOGEGRAMMENI

359+foldMapping '\x1fa7' s = Yield '\x1f67' (s :!: '\x03b9' :!: '\x0000')

360+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PROSGEGRAMMENI

361+foldMapping '\x1fa8' s = Yield '\x1f60' (s :!: '\x03b9' :!: '\x0000')

362+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PROSGEGRAMMENI

363+foldMapping '\x1fa9' s = Yield '\x1f61' (s :!: '\x03b9' :!: '\x0000')

364+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND VARIA AND PROSGEGRAMMENI

365+foldMapping '\x1faa' s = Yield '\x1f62' (s :!: '\x03b9' :!: '\x0000')

366+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND VARIA AND PROSGEGRAMMENI

367+foldMapping '\x1fab' s = Yield '\x1f63' (s :!: '\x03b9' :!: '\x0000')

368+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND OXIA AND PROSGEGRAMMENI

369+foldMapping '\x1fac' s = Yield '\x1f64' (s :!: '\x03b9' :!: '\x0000')

370+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND OXIA AND PROSGEGRAMMENI

371+foldMapping '\x1fad' s = Yield '\x1f65' (s :!: '\x03b9' :!: '\x0000')

372+-- GREEK CAPITAL LETTER OMEGA WITH PSILI AND PERISPOMENI AND PROSGEGRAMMENI

373+foldMapping '\x1fae' s = Yield '\x1f66' (s :!: '\x03b9' :!: '\x0000')

374+-- GREEK CAPITAL LETTER OMEGA WITH DASIA AND PERISPOMENI AND PROSGEGRAMMENI

375+foldMapping '\x1faf' s = Yield '\x1f67' (s :!: '\x03b9' :!: '\x0000')

376+-- GREEK SMALL LETTER ALPHA WITH VARIA AND YPOGEGRAMMENI

377+foldMapping '\x1fb2' s = Yield '\x1f70' (s :!: '\x03b9' :!: '\x0000')

378+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI

379+foldMapping '\x1fb3' s = Yield '\x03b1' (s :!: '\x03b9' :!: '\x0000')

380+-- GREEK SMALL LETTER ALPHA WITH OXIA AND YPOGEGRAMMENI

381+foldMapping '\x1fb4' s = Yield '\x03ac' (s :!: '\x03b9' :!: '\x0000')

382+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

383+foldMapping '\x1fb6' s = Yield '\x03b1' (s :!: '\x0342' :!: '\x0000')

384+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI AND YPOGEGRAMMENI

385+foldMapping '\x1fb7' s = Yield '\x03b1' (s :!: '\x0342' :!: '\x03b9')

386+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI

387+foldMapping '\x1fbc' s = Yield '\x03b1' (s :!: '\x03b9' :!: '\x0000')

388+-- GREEK PROSGEGRAMMENI

389+foldMapping '\x1fbe' s = Yield '\x03b9' (s :!: '\x0000' :!: '\x0000')

390+-- GREEK SMALL LETTER ETA WITH VARIA AND YPOGEGRAMMENI

391+foldMapping '\x1fc2' s = Yield '\x1f74' (s :!: '\x03b9' :!: '\x0000')

392+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI

393+foldMapping '\x1fc3' s = Yield '\x03b7' (s :!: '\x03b9' :!: '\x0000')

394+-- GREEK SMALL LETTER ETA WITH OXIA AND YPOGEGRAMMENI

395+foldMapping '\x1fc4' s = Yield '\x03ae' (s :!: '\x03b9' :!: '\x0000')

396+-- GREEK SMALL LETTER ETA WITH PERISPOMENI

397+foldMapping '\x1fc6' s = Yield '\x03b7' (s :!: '\x0342' :!: '\x0000')

398+-- GREEK SMALL LETTER ETA WITH PERISPOMENI AND YPOGEGRAMMENI

399+foldMapping '\x1fc7' s = Yield '\x03b7' (s :!: '\x0342' :!: '\x03b9')

400+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI

401+foldMapping '\x1fcc' s = Yield '\x03b7' (s :!: '\x03b9' :!: '\x0000')

402+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND VARIA

403+foldMapping '\x1fd2' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0300')

404+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND OXIA

405+foldMapping '\x1fd3' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0301')

406+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

407+foldMapping '\x1fd6' s = Yield '\x03b9' (s :!: '\x0342' :!: '\x0000')

408+-- GREEK SMALL LETTER IOTA WITH DIALYTIKA AND PERISPOMENI

409+foldMapping '\x1fd7' s = Yield '\x03b9' (s :!: '\x0308' :!: '\x0342')

410+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND VARIA

411+foldMapping '\x1fe2' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0300')

412+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND OXIA

413+foldMapping '\x1fe3' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0301')

414+-- GREEK SMALL LETTER RHO WITH PSILI

415+foldMapping '\x1fe4' s = Yield '\x03c1' (s :!: '\x0313' :!: '\x0000')

416+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

417+foldMapping '\x1fe6' s = Yield '\x03c5' (s :!: '\x0342' :!: '\x0000')

418+-- GREEK SMALL LETTER UPSILON WITH DIALYTIKA AND PERISPOMENI

419+foldMapping '\x1fe7' s = Yield '\x03c5' (s :!: '\x0308' :!: '\x0342')

420+-- GREEK SMALL LETTER OMEGA WITH VARIA AND YPOGEGRAMMENI

421+foldMapping '\x1ff2' s = Yield '\x1f7c' (s :!: '\x03b9' :!: '\x0000')

422+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI

423+foldMapping '\x1ff3' s = Yield '\x03c9' (s :!: '\x03b9' :!: '\x0000')

424+-- GREEK SMALL LETTER OMEGA WITH OXIA AND YPOGEGRAMMENI

425+foldMapping '\x1ff4' s = Yield '\x03ce' (s :!: '\x03b9' :!: '\x0000')

426+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

427+foldMapping '\x1ff6' s = Yield '\x03c9' (s :!: '\x0342' :!: '\x0000')

428+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI AND YPOGEGRAMMENI

429+foldMapping '\x1ff7' s = Yield '\x03c9' (s :!: '\x0342' :!: '\x03b9')

430+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

431+foldMapping '\x1ffc' s = Yield '\x03c9' (s :!: '\x03b9' :!: '\x0000')

432+-- LATIN SMALL LIGATURE FF

433+foldMapping '\xfb00' s = Yield '\x0066' (s :!: '\x0066' :!: '\x0000')

434+-- LATIN SMALL LIGATURE FI

435+foldMapping '\xfb01' s = Yield '\x0066' (s :!: '\x0069' :!: '\x0000')

436+-- LATIN SMALL LIGATURE FL

437+foldMapping '\xfb02' s = Yield '\x0066' (s :!: '\x006c' :!: '\x0000')

438+-- LATIN SMALL LIGATURE FFI

439+foldMapping '\xfb03' s = Yield '\x0066' (s :!: '\x0066' :!: '\x0069')

440+-- LATIN SMALL LIGATURE FFL

441+foldMapping '\xfb04' s = Yield '\x0066' (s :!: '\x0066' :!: '\x006c')

442+-- LATIN SMALL LIGATURE LONG S T

443+foldMapping '\xfb05' s = Yield '\x0073' (s :!: '\x0074' :!: '\x0000')

444+-- LATIN SMALL LIGATURE ST

445+foldMapping '\xfb06' s = Yield '\x0073' (s :!: '\x0074' :!: '\x0000')

446+-- ARMENIAN SMALL LIGATURE MEN NOW

447+foldMapping '\xfb13' s = Yield '\x0574' (s :!: '\x0576' :!: '\x0000')

448+-- ARMENIAN SMALL LIGATURE MEN ECH

449+foldMapping '\xfb14' s = Yield '\x0574' (s :!: '\x0565' :!: '\x0000')

450+-- ARMENIAN SMALL LIGATURE MEN INI

451+foldMapping '\xfb15' s = Yield '\x0574' (s :!: '\x056b' :!: '\x0000')

452+-- ARMENIAN SMALL LIGATURE VEW NOW

453+foldMapping '\xfb16' s = Yield '\x057e' (s :!: '\x0576' :!: '\x0000')

454+-- ARMENIAN SMALL LIGATURE MEN XEH

455+foldMapping '\xfb17' s = Yield '\x0574' (s :!: '\x056d' :!: '\x0000')

456+foldMapping c s = Yield (toLower c) (s :!: '\0' :!: '\0')

Data/Text/Fusion/Common.hs+31−2

@@ -36,8 +36,10 @@ module Data.Text.Fusion.Common

3636 , intersperse

3737

3838 -- ** Case conversion

39− , toUpper

39+ -- $case

40+ , toCaseFold

4041 , toLower

42+ , toUpper

4143

4244 -- * Folds

4345 , foldl

@@ -100,7 +102,7 @@ import Prelude (Bool(..), Char, Either(..), Eq(..), Int, Integral, Maybe(..),

100102import qualified Data.List as L

101103import qualified Prelude as P

102104import Data.Text.Fusion.Internal

103−import Data.Text.Fusion.CaseMapping (lowerMapping, upperMapping)

105+import Data.Text.Fusion.CaseMapping (foldMapping, lowerMapping, upperMapping)

104106

105107singleton :: Char -> Stream Char

106108singleton c = Stream next False 1 -- HINT maybe too low

@@ -300,6 +302,15 @@ intersperse c (Stream next0 s0 len) = Stream next (s0 :!: N :!: S1) len -- HINT

300302-- ----------------------------------------------------------------------------

301303-- ** Case conversions (folds)

302304

305+-- $case

306+--

307+-- With Unicode text, it is incorrect to use combinators like @map

308+-- toUpper@ to case convert each character of a string individually.

309+-- Instead, use the whole-string case conversion functions from this

310+-- module. For correctness in different writing systems, these

311+-- functions may map one input character to two or three output

312+-- characters.

313+

303314caseConvert :: (forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char)

304315 -> Stream Char -> Stream Char

305316caseConvert remap (Stream next0 s0 len) = Stream next (s0 :!: '\0' :!: '\0') len

@@ -312,6 +323,24 @@ caseConvert remap (Stream next0 s0 len) = Stream next (s0 :!: '\0' :!: '\0') len

312323 Yield c s' -> remap c s'

313324 next (s :!: a :!: b) = Yield a (s :!: b :!: '\0')

314325

326+-- | /O(n)/ Convert a string to folded case. This function is mainly

327+-- useful for performing caseless (or case insensitive) string

328+-- comparisons.

329+--

330+-- A string @x@ is a caseless match for a string @y@ if and only if:

331+--

332+-- @toCaseFold x == toCaseFold y@

333+--

334+-- The result string may be longer than the input string, and may

335+-- differ from applying 'toLower' to the input string. For instance,

336+-- the Armenian small ligature men now (U+FB13) is case folded to the

337+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is

338+-- case folded to the Greek small letter letter mu (U+03BC) instead of

339+-- itself.

340+toCaseFold :: Stream Char -> Stream Char

341+toCaseFold = caseConvert foldMapping

342+{-# INLINE [0] toCaseFold #-}

343+

315344-- | /O(n)/ Convert a string to upper case, using simple case

316345-- conversion. The result string may be longer than the input string.

317346-- For instance, the German eszett (U+00DF) maps to the two-letter

Data/Text/Lazy.hs+40−8

@@ -59,8 +59,10 @@ module Data.Text.Lazy

5959 , reverse

6060

6161 -- ** Case conversion

62− , toUpper

62+ -- $case

63+ , toCaseFold

6364 , toLower

65+ , toUpper

6466

6567 -- * Folds

6668 , foldl

@@ -371,13 +373,35 @@ reverse = rev Empty

371373 where rev a Empty = a

372374 rev a (Chunk t ts) = rev (Chunk (T.reverse t) a) ts

373375

374−-- | /O(n)/ Convert a string to upper case, using simple case

375−-- conversion. The result string may be longer than the input string.

376−-- For instance, the German eszett (U+00DF) maps to the two-letter

377−-- sequence SS.

378−toUpper :: Text -> Text

379−toUpper t = unstream (S.toUpper (stream t))

380−{-# INLINE toUpper #-}

376+-- ----------------------------------------------------------------------------

377+-- ** Case conversions (folds)

378+

379+-- $case

380+--

381+-- With Unicode text, it is incorrect to use combinators like @map

382+-- toUpper@ to case convert each character of a string individually.

383+-- Instead, use the whole-string case conversion functions from this

384+-- module. For correctness in different writing systems, these

385+-- functions may map one input character to two or three output

386+-- characters.

387+

388+-- | /O(n)/ Convert a string to folded case. This function is mainly

389+-- useful for performing caseless (or case insensitive) string

390+-- comparisons.

391+--

392+-- A string @x@ is a caseless match for a string @y@ if and only if:

393+--

394+-- @toCaseFold x == toCaseFold y@

395+--

396+-- The result string may be longer than the input string, and may

397+-- differ from applying 'toLower' to the input string. For instance,

398+-- the Armenian small ligature men now (U+FB13) is case folded to the

399+-- bigram men now (U+0574 U+0576), while the micro sign (U+00B5) is

400+-- case folded to the Greek small letter letter mu (U+03BC) instead of

401+-- itself.

402+toCaseFold :: Text -> Text

403+toCaseFold t = unstream (S.toCaseFold (stream t))

404+{-# INLINE [0] toCaseFold #-}

381405

382406-- | /O(n)/ Convert a string to lower case, using simple case

383407-- conversion. The result string may be longer than the input string.

@@ -388,6 +412,14 @@ toLower :: Text -> Text

388412toLower t = unstream (S.toLower (stream t))

389413{-# INLINE toLower #-}

390414

415+-- | /O(n)/ Convert a string to upper case, using simple case

416+-- conversion. The result string may be longer than the input string.

417+-- For instance, the German eszett (U+00DF) maps to the two-letter

418+-- sequence SS.

419+toUpper :: Text -> Text

420+toUpper t = unstream (S.toUpper (stream t))

421+{-# INLINE toUpper #-}

422+

391423-- | /O(n)/ 'foldl', applied to a binary operator, a starting value

392424-- (typically the left-identity of the operator), and a 'Text',

393425-- reduces the 'Text' using the binary operator, from left to right.

scripts/Arsec.hsnew file+49

@@ -0,0 +1,49 @@

1+module Arsec

2+ (

3+ comment

4+ , semi

5+ , showC

6+ , unichar

7+ , unichars

8+ , module Control.Applicative

9+ , module Control.Monad

10+ , module Data.Char

11+ , module Text.ParserCombinators.Parsec.Char

12+ , module Text.ParserCombinators.Parsec.Combinator

13+ , module Text.ParserCombinators.Parsec.Error

14+ , module Text.ParserCombinators.Parsec.Prim

15+ ) where

16+

17+import Control.Monad

18+import Control.Applicative

19+import Data.Char

20+import Numeric

21+import Text.ParserCombinators.Parsec.Char hiding (lower, upper)

22+import Text.ParserCombinators.Parsec.Combinator hiding (optional)

23+import Text.ParserCombinators.Parsec.Error

24+import Text.ParserCombinators.Parsec.Prim hiding ((<|>), many)

25+

26+instance Applicative (GenParser s a) where

27+ pure = return

28+ (<*>) = ap

29+

30+instance Alternative (GenParser s a) where

31+ empty = mzero

32+ (<|>) = mplus

33+

34+unichar :: Parser Char

35+unichar = chr . fst . head . readHex <$> many1 hexDigit

36+

37+unichars :: Parser [Char]

38+unichars = manyTill (unichar <* spaces) semi

39+

40+semi :: Parser ()

41+semi = char ';' *> spaces *> pure ()

42+

43+comment :: Parser String

44+comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"

45+

46+showC :: Char -> String

47+showC c = "'\\x" ++ d ++ "'"

48+ where h = showHex (ord c) ""

49+ d = replicate (4 - length h) '0' ++ h

scripts/CaseFolding.hsnew file+42

@@ -0,0 +1,42 @@

1+-- This script processes the following source file:

2+--

3+-- http://unicode.org/Public/UNIDATA/CaseFolding.txt

5+module CaseFolding

6+ (

7+ Fold(..)

8+ , parseCF

9+ , mapCF

10+ ) where

11+

12+import Arsec

13+

14+data Fold = Fold {

15+ code :: Char

16+ , status :: Char

17+ , mapping :: [Char]

18+ , name :: String

19+ } deriving (Eq, Ord, Show)

20+

21+entries :: Parser [Fold]

22+entries = many comment *> many (entry <* many comment)

23+ where

24+ entry = Fold <$> unichar <* semi

25+ <*> oneOf "CFST" <* semi

26+ <*> unichars

27+ <*> (string "# " *> manyTill anyToken (char '\n'))

28+

29+parseCF :: FilePath -> IO (Either ParseError [Fold])

30+parseCF name = parse entries name <$> readFile name

31+

32+mapCF :: [Fold] -> [String]

33+mapCF ms = typ ++ (map nice . filter p $ ms) ++ [last]

34+ where

35+ typ = ["foldMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char"

36+ ,"{-# INLINE foldMapping #-}"]

37+ last = "foldMapping c s = Yield (toLower c) (s :!: '\\0' :!: '\\0')"

38+ nice c = "-- " ++ name c ++ "\n" ++

39+ "foldMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (s :!: " ++ y ++ " :!: " ++ z ++ ")"

40+ where [x,y,z] = (map showC . take 3) (mapping c ++ repeat '\0')

41+ p f = status f `elem` "CF" &&

42+ mapping f /= [toLower (code f)]

scripts/CaseMapping.hsnew file+32

@@ -0,0 +1,32 @@

1+import System.Environment

2+import System.IO

4+import Arsec

5+import CaseFolding

6+import SpecialCasing

8+main = do

9+ args <- getArgs

10+ let oname = case args of

11+ [] -> "../Data/Text/Fusion/CaseMapping.hs"

12+ [o] -> o

13+ psc <- parseSC "SpecialCasing.txt"

14+ pcf <- parseCF "CaseFolding.txt"

15+ scs <- case psc of

16+ Left err -> print err >> return undefined

17+ Right ms -> return ms

18+ cfs <- case pcf of

19+ Left err -> print err >> return undefined

20+ Right ms -> return ms

21+ h <- openFile oname WriteMode

22+ mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"

23+ ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

24+ ,"-- Generated by scripts/SpecialCasing.hs"

25+ ,"module Data.Text.Fusion.CaseMapping where"

26+ ,"import Data.Char"

27+ ,"import Data.Text.Fusion.Internal"

28+ ,""]

29+ mapM_ (hPutStrLn h) (mapSC "upper" upper toUpper scs)

30+ mapM_ (hPutStrLn h) (mapSC "lower" lower toLower scs)

31+ mapM_ (hPutStrLn h) (mapCF cfs)

32+ hClose h

scripts/SpecialCasing.hs+15−47

@@ -1,19 +1,15 @@

1−import Control.Applicative

2−import Control.Monad

3−import Data.Char

4−import Numeric

5−import System.Environment

6−import System.IO

7−import Text.ParserCombinators.Parsec hiding (many, optional, upper, lower, (<|>))

8−import Text.ParserCombinators.Parsec.Combinator

1+-- This script processes the following source file:

2+--

3+-- http://unicode.org/Public/UNIDATA/SpecialCasing.txt

10−instance Applicative (GenParser s a) where

11− pure = return

12− (<*>) = ap

13−

14−instance Alternative (GenParser s a) where

15− empty = mzero

16− (<|>) = mplus

5+module SpecialCasing

6+ (

7+ Case(..)

8+ , parseSC

9+ , mapSC

10+ ) where

11+

12+import Arsec

1713

1814data Case = Case {

1915 code :: Char

@@ -33,15 +29,12 @@ entries = many comment *> many (entry <* many comment)

3329 <*> unichars

3430 <*> manyTill anyToken (string "# ")

3531 <*> manyTill anyToken (char '\n')

36− unichar = chr . fst . head . readHex <$> replicateM 4 (satisfy isHexDigit)

37− unichars = manyTill (unichar <* spaces) semi

38− semi = char ';' *> spaces *> pure ()

39− comment = (char '#' *> manyTill anyToken (char '\n')) <|> string "\n"

4032

41−parseFile :: FilePath -> IO (Either ParseError [Case])

42−parseFile name = parse entries name <$> readFile name

33+parseSC :: FilePath -> IO (Either ParseError [Case])

34+parseSC name = parse entries name <$> readFile name

4335

44−mapFunc which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]

36+mapSC :: String -> (Case -> String) -> (Char -> Char) -> [Case] -> [String]

37+mapSC which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]

4538 where

4639 typ = [which ++ "Mapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char"

4740 ,"{-# INLINE " ++ which ++ "Mapping #-}"]

@@ -52,31 +45,6 @@ mapFunc which access twiddle ms = typ ++ (map nice . filter p $ ms) ++ [last]

5245 p c = [k] /= a && a /= [twiddle k] && null (conditions c)

5346 where a = access c

5447 k = code c

55− showC c = "'\\x" ++ d ++ "'"

56− where h = showHex (ord c) ""

57− d = replicate (4 - length h) '0' ++ h

5848

5949ucFirst (c:cs) = toUpper c : cs

6050ucFirst [] = []

61−

62−main = do

63− args <- getArgs

64− let (iname, oname) = case args of

65− [] -> ("SpecialCasing.txt", "CaseMapping.hs")

66− [i] -> (i, "CaseMapping.hs")

67− [i,o] -> (i,o)

68− p <- parseFile iname

69− ms <- case p of

70− Left err -> print err >> return undefined

71− Right ms -> return ms

72− h <- openFile oname WriteMode

73− mapM_ (hPutStrLn h) ["{-# LANGUAGE Rank2Types #-}"

74− ,"-- AUTOMATICALLY GENERATED - DO NOT EDIT"

75− ,"-- Generated by scripts/SpecialCasing.hs"

76− ,"module Data.Text.Fusion.CaseMapping where"

77− ,"import Data.Char"

78− ,"import Data.Text.Fusion.Internal"

79− ,""]

80− mapM_ (hPutStrLn h) (mapFunc "upper" upper toUpper ms)

81− mapM_ (hPutStrLn h) (mapFunc "lower" lower toLower ms)

82− hClose h