7c53770 · text · git.iko.soy

git.iko.soy/text

Support for case conversion

--HG-- extra : convert_revision : 88ed6e5bd681088ec84a8ac303afe432c4f57411

commit7c53770e0b7d741742cfe59e6d85788da3e4b51d authorBryan O'Sullivan <bos@serpentine.com> dateSat 6 Jun 2009, 17:12 (17 years ago) parent8766bac

6 files changed+333

compare with master

unifiedsplit

Data/Text.hs+11 Data/Text/Fusion/CaseMapping.hs+212 Data/Text/Fusion/Common.hs+23 Data/Text/Lazy.hs+11 scripts/SpecialCasing.hs+75 text.cabal+1

Data/Text.hs+11

@@ -55,6 +55,9 @@ module Data.Text

5555 , transpose

5656 , reverse

5757

58+ -- * Case conversion

59+ , toUpper

60+

5861 -- * Folds

5962 , foldl

6063 , foldl'

@@ -381,6 +384,14 @@ reverse :: Text -> Text

381384reverse t = S.reverse (stream t)

382385{-# INLINE reverse #-}

383386

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

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

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

390+-- sequence SS.

391+toUpper :: Text -> Text

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

393+{-# INLINE toUpper #-}

394+

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

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

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

Data/Text/Fusion/CaseMapping.hsnew file+212

@@ -0,0 +1,212 @@

1+{-# LANGUAGE Rank2Types #-}

2+module Data.Text.Fusion.CaseMapping where

3+import Data.Char

4+import Data.Text.Fusion.Internal

6+upperMapping :: forall s. Char -> s -> Step (PairS (PairS s Char) Char) Char

7+{-# INLINE upperMapping #-}

8+-- LATIN SMALL LETTER SHARP S

9+upperMapping '\x00df' s = Yield '\x0053' (s :!: '\x0053' :!: '\x0000')

10+-- LATIN SMALL LIGATURE FF

11+upperMapping '\xfb00' s = Yield '\x0046' (s :!: '\x0046' :!: '\x0000')

12+-- LATIN SMALL LIGATURE FI

13+upperMapping '\xfb01' s = Yield '\x0046' (s :!: '\x0049' :!: '\x0000')

14+-- LATIN SMALL LIGATURE FL

15+upperMapping '\xfb02' s = Yield '\x0046' (s :!: '\x004c' :!: '\x0000')

16+-- LATIN SMALL LIGATURE FFI

17+upperMapping '\xfb03' s = Yield '\x0046' (s :!: '\x0046' :!: '\x0049')

18+-- LATIN SMALL LIGATURE FFL

19+upperMapping '\xfb04' s = Yield '\x0046' (s :!: '\x0046' :!: '\x004c')

20+-- LATIN SMALL LIGATURE LONG S T

21+upperMapping '\xfb05' s = Yield '\x0053' (s :!: '\x0054' :!: '\x0000')

22+-- LATIN SMALL LIGATURE ST

23+upperMapping '\xfb06' s = Yield '\x0053' (s :!: '\x0054' :!: '\x0000')

24+-- ARMENIAN SMALL LIGATURE ECH YIWN

25+upperMapping '\x0587' s = Yield '\x0535' (s :!: '\x0552' :!: '\x0000')

26+-- ARMENIAN SMALL LIGATURE MEN NOW

27+upperMapping '\xfb13' s = Yield '\x0544' (s :!: '\x0546' :!: '\x0000')

28+-- ARMENIAN SMALL LIGATURE MEN ECH

29+upperMapping '\xfb14' s = Yield '\x0544' (s :!: '\x0535' :!: '\x0000')

30+-- ARMENIAN SMALL LIGATURE MEN INI

31+upperMapping '\xfb15' s = Yield '\x0544' (s :!: '\x053b' :!: '\x0000')

32+-- ARMENIAN SMALL LIGATURE VEW NOW

33+upperMapping '\xfb16' s = Yield '\x054e' (s :!: '\x0546' :!: '\x0000')

34+-- ARMENIAN SMALL LIGATURE MEN XEH

35+upperMapping '\xfb17' s = Yield '\x0544' (s :!: '\x053d' :!: '\x0000')

36+-- LATIN SMALL LETTER N PRECEDED BY APOSTROPHE

37+upperMapping '\x0149' s = Yield '\x02bc' (s :!: '\x004e' :!: '\x0000')

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

39+upperMapping '\x0390' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0301')

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

41+upperMapping '\x03b0' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0301')

42+-- LATIN SMALL LETTER J WITH CARON

43+upperMapping '\x01f0' s = Yield '\x004a' (s :!: '\x030c' :!: '\x0000')

44+-- LATIN SMALL LETTER H WITH LINE BELOW

45+upperMapping '\x1e96' s = Yield '\x0048' (s :!: '\x0331' :!: '\x0000')

46+-- LATIN SMALL LETTER T WITH DIAERESIS

47+upperMapping '\x1e97' s = Yield '\x0054' (s :!: '\x0308' :!: '\x0000')

48+-- LATIN SMALL LETTER W WITH RING ABOVE

49+upperMapping '\x1e98' s = Yield '\x0057' (s :!: '\x030a' :!: '\x0000')

50+-- LATIN SMALL LETTER Y WITH RING ABOVE

51+upperMapping '\x1e99' s = Yield '\x0059' (s :!: '\x030a' :!: '\x0000')

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

53+upperMapping '\x1e9a' s = Yield '\x0041' (s :!: '\x02be' :!: '\x0000')

54+-- GREEK SMALL LETTER UPSILON WITH PSILI

55+upperMapping '\x1f50' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0000')

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

57+upperMapping '\x1f52' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0300')

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

59+upperMapping '\x1f54' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0301')

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

61+upperMapping '\x1f56' s = Yield '\x03a5' (s :!: '\x0313' :!: '\x0342')

62+-- GREEK SMALL LETTER ALPHA WITH PERISPOMENI

63+upperMapping '\x1fb6' s = Yield '\x0391' (s :!: '\x0342' :!: '\x0000')

64+-- GREEK SMALL LETTER ETA WITH PERISPOMENI

65+upperMapping '\x1fc6' s = Yield '\x0397' (s :!: '\x0342' :!: '\x0000')

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

67+upperMapping '\x1fd2' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0300')

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

69+upperMapping '\x1fd3' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0301')

70+-- GREEK SMALL LETTER IOTA WITH PERISPOMENI

71+upperMapping '\x1fd6' s = Yield '\x0399' (s :!: '\x0342' :!: '\x0000')

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

73+upperMapping '\x1fd7' s = Yield '\x0399' (s :!: '\x0308' :!: '\x0342')

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

75+upperMapping '\x1fe2' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0300')

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

77+upperMapping '\x1fe3' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0301')

78+-- GREEK SMALL LETTER RHO WITH PSILI

79+upperMapping '\x1fe4' s = Yield '\x03a1' (s :!: '\x0313' :!: '\x0000')

80+-- GREEK SMALL LETTER UPSILON WITH PERISPOMENI

81+upperMapping '\x1fe6' s = Yield '\x03a5' (s :!: '\x0342' :!: '\x0000')

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

83+upperMapping '\x1fe7' s = Yield '\x03a5' (s :!: '\x0308' :!: '\x0342')

84+-- GREEK SMALL LETTER OMEGA WITH PERISPOMENI

85+upperMapping '\x1ff6' s = Yield '\x03a9' (s :!: '\x0342' :!: '\x0000')

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

87+upperMapping '\x1f80' s = Yield '\x1f08' (s :!: '\x0399' :!: '\x0000')

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

89+upperMapping '\x1f81' s = Yield '\x1f09' (s :!: '\x0399' :!: '\x0000')

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

91+upperMapping '\x1f82' s = Yield '\x1f0a' (s :!: '\x0399' :!: '\x0000')

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

93+upperMapping '\x1f83' s = Yield '\x1f0b' (s :!: '\x0399' :!: '\x0000')

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

95+upperMapping '\x1f84' s = Yield '\x1f0c' (s :!: '\x0399' :!: '\x0000')

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

97+upperMapping '\x1f85' s = Yield '\x1f0d' (s :!: '\x0399' :!: '\x0000')

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

99+upperMapping '\x1f86' s = Yield '\x1f0e' (s :!: '\x0399' :!: '\x0000')

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

101+upperMapping '\x1f87' s = Yield '\x1f0f' (s :!: '\x0399' :!: '\x0000')

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

103+upperMapping '\x1f88' s = Yield '\x1f08' (s :!: '\x0399' :!: '\x0000')

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

105+upperMapping '\x1f89' s = Yield '\x1f09' (s :!: '\x0399' :!: '\x0000')

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

107+upperMapping '\x1f8a' s = Yield '\x1f0a' (s :!: '\x0399' :!: '\x0000')

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

109+upperMapping '\x1f8b' s = Yield '\x1f0b' (s :!: '\x0399' :!: '\x0000')

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

111+upperMapping '\x1f8c' s = Yield '\x1f0c' (s :!: '\x0399' :!: '\x0000')

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

113+upperMapping '\x1f8d' s = Yield '\x1f0d' (s :!: '\x0399' :!: '\x0000')

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

115+upperMapping '\x1f8e' s = Yield '\x1f0e' (s :!: '\x0399' :!: '\x0000')

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

117+upperMapping '\x1f8f' s = Yield '\x1f0f' (s :!: '\x0399' :!: '\x0000')

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

119+upperMapping '\x1f90' s = Yield '\x1f28' (s :!: '\x0399' :!: '\x0000')

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

121+upperMapping '\x1f91' s = Yield '\x1f29' (s :!: '\x0399' :!: '\x0000')

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

123+upperMapping '\x1f92' s = Yield '\x1f2a' (s :!: '\x0399' :!: '\x0000')

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

125+upperMapping '\x1f93' s = Yield '\x1f2b' (s :!: '\x0399' :!: '\x0000')

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

127+upperMapping '\x1f94' s = Yield '\x1f2c' (s :!: '\x0399' :!: '\x0000')

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

129+upperMapping '\x1f95' s = Yield '\x1f2d' (s :!: '\x0399' :!: '\x0000')

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

131+upperMapping '\x1f96' s = Yield '\x1f2e' (s :!: '\x0399' :!: '\x0000')

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

133+upperMapping '\x1f97' s = Yield '\x1f2f' (s :!: '\x0399' :!: '\x0000')

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

135+upperMapping '\x1f98' s = Yield '\x1f28' (s :!: '\x0399' :!: '\x0000')

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

137+upperMapping '\x1f99' s = Yield '\x1f29' (s :!: '\x0399' :!: '\x0000')

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

139+upperMapping '\x1f9a' s = Yield '\x1f2a' (s :!: '\x0399' :!: '\x0000')

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

141+upperMapping '\x1f9b' s = Yield '\x1f2b' (s :!: '\x0399' :!: '\x0000')

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

143+upperMapping '\x1f9c' s = Yield '\x1f2c' (s :!: '\x0399' :!: '\x0000')

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

145+upperMapping '\x1f9d' s = Yield '\x1f2d' (s :!: '\x0399' :!: '\x0000')

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

147+upperMapping '\x1f9e' s = Yield '\x1f2e' (s :!: '\x0399' :!: '\x0000')

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

149+upperMapping '\x1f9f' s = Yield '\x1f2f' (s :!: '\x0399' :!: '\x0000')

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

151+upperMapping '\x1fa0' s = Yield '\x1f68' (s :!: '\x0399' :!: '\x0000')

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

153+upperMapping '\x1fa1' s = Yield '\x1f69' (s :!: '\x0399' :!: '\x0000')

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

155+upperMapping '\x1fa2' s = Yield '\x1f6a' (s :!: '\x0399' :!: '\x0000')

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

157+upperMapping '\x1fa3' s = Yield '\x1f6b' (s :!: '\x0399' :!: '\x0000')

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

159+upperMapping '\x1fa4' s = Yield '\x1f6c' (s :!: '\x0399' :!: '\x0000')

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

161+upperMapping '\x1fa5' s = Yield '\x1f6d' (s :!: '\x0399' :!: '\x0000')

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

163+upperMapping '\x1fa6' s = Yield '\x1f6e' (s :!: '\x0399' :!: '\x0000')

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

165+upperMapping '\x1fa7' s = Yield '\x1f6f' (s :!: '\x0399' :!: '\x0000')

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

167+upperMapping '\x1fa8' s = Yield '\x1f68' (s :!: '\x0399' :!: '\x0000')

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

169+upperMapping '\x1fa9' s = Yield '\x1f69' (s :!: '\x0399' :!: '\x0000')

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

171+upperMapping '\x1faa' s = Yield '\x1f6a' (s :!: '\x0399' :!: '\x0000')

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

173+upperMapping '\x1fab' s = Yield '\x1f6b' (s :!: '\x0399' :!: '\x0000')

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

175+upperMapping '\x1fac' s = Yield '\x1f6c' (s :!: '\x0399' :!: '\x0000')

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

177+upperMapping '\x1fad' s = Yield '\x1f6d' (s :!: '\x0399' :!: '\x0000')

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

179+upperMapping '\x1fae' s = Yield '\x1f6e' (s :!: '\x0399' :!: '\x0000')

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

181+upperMapping '\x1faf' s = Yield '\x1f6f' (s :!: '\x0399' :!: '\x0000')

182+-- GREEK SMALL LETTER ALPHA WITH YPOGEGRAMMENI

183+upperMapping '\x1fb3' s = Yield '\x0391' (s :!: '\x0399' :!: '\x0000')

184+-- GREEK CAPITAL LETTER ALPHA WITH PROSGEGRAMMENI

185+upperMapping '\x1fbc' s = Yield '\x0391' (s :!: '\x0399' :!: '\x0000')

186+-- GREEK SMALL LETTER ETA WITH YPOGEGRAMMENI

187+upperMapping '\x1fc3' s = Yield '\x0397' (s :!: '\x0399' :!: '\x0000')

188+-- GREEK CAPITAL LETTER ETA WITH PROSGEGRAMMENI

189+upperMapping '\x1fcc' s = Yield '\x0397' (s :!: '\x0399' :!: '\x0000')

190+-- GREEK SMALL LETTER OMEGA WITH YPOGEGRAMMENI

191+upperMapping '\x1ff3' s = Yield '\x03a9' (s :!: '\x0399' :!: '\x0000')

192+-- GREEK CAPITAL LETTER OMEGA WITH PROSGEGRAMMENI

193+upperMapping '\x1ffc' s = Yield '\x03a9' (s :!: '\x0399' :!: '\x0000')

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

195+upperMapping '\x1fb2' s = Yield '\x1fba' (s :!: '\x0399' :!: '\x0000')

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

197+upperMapping '\x1fb4' s = Yield '\x0386' (s :!: '\x0399' :!: '\x0000')

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

199+upperMapping '\x1fc2' s = Yield '\x1fca' (s :!: '\x0399' :!: '\x0000')

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

201+upperMapping '\x1fc4' s = Yield '\x0389' (s :!: '\x0399' :!: '\x0000')

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

203+upperMapping '\x1ff2' s = Yield '\x1ffa' (s :!: '\x0399' :!: '\x0000')

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

205+upperMapping '\x1ff4' s = Yield '\x038f' (s :!: '\x0399' :!: '\x0000')

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

207+upperMapping '\x1fb7' s = Yield '\x0391' (s :!: '\x0342' :!: '\x0399')

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

209+upperMapping '\x1fc7' s = Yield '\x0397' (s :!: '\x0342' :!: '\x0399')

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

211+upperMapping '\x1ff7' s = Yield '\x03a9' (s :!: '\x0342' :!: '\x0399')

212+upperMapping c s = Yield (toUpper c) (s :!: '\0' :!: '\0')

Data/Text/Fusion/Common.hs+23

@@ -35,6 +35,9 @@ module Data.Text.Fusion.Common

3535 , intercalate

3636 , intersperse

3737

38+ -- ** Case conversion

39+ , toUpper

40+

3841 -- * Folds

3942 , foldl

4043 , foldl'

@@ -96,6 +99,7 @@ import Prelude (Bool(..), Char, Either(..), Eq(..), Int, Integral, Maybe(..),

9699import qualified Data.List as L

97100import qualified Prelude as P

98101import Data.Text.Fusion.Internal

102+import Data.Text.Fusion.CaseMapping (upperMapping)

99103

100104singleton :: Char -> Stream Char

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

@@ -292,6 +296,25 @@ intersperse c (Stream next0 s0 len) = Stream next (s0 :!: N :!: S1) len -- HINT

292296 next _ = internalError "intersperse"

293297{-# INLINE [0] intersperse #-}

294298

299+-- ----------------------------------------------------------------------------

300+-- ** Case conversions (folds)

301+

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

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

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

305+-- sequence SS.

306+toUpper :: Stream Char -> Stream Char

307+toUpper (Stream next0 s0 len) = Stream next (s0 :!: '\0' :!: '\0') len

308+ where

309+ {-# INLINE next #-}

310+ next (s :!: '\0' :!: _) =

311+ case next0 s of

312+ Done -> Done

313+ Skip s' -> Skip (s' :!: '\0' :!: '\0')

314+ Yield c s' -> upperMapping c s'

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

316+{-# INLINE [0] toUpper #-}

317+

295318-- ----------------------------------------------------------------------------

296319-- * Reducing Streams (folds)

297320

Data/Text/Lazy.hs+11

@@ -58,6 +58,9 @@ module Data.Text.Lazy

5858 , transpose

5959 , reverse

6060

61+ -- ** Case conversion

62+ , toUpper

63+

6164 -- * Folds

6265 , foldl

6366 , foldl'

@@ -367,6 +370,14 @@ reverse = rev Empty

367370 where rev a Empty = a

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

369372

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

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

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

376+-- sequence SS.

377+toUpper :: Text -> Text

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

379+{-# INLINE toUpper #-}

380+

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

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

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

scripts/SpecialCasing.hsnew file+75

@@ -0,0 +1,75 @@

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, (<|>))

8+import Text.ParserCombinators.Parsec.Combinator

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

17+

18+data Case = Case {

19+ code :: Char

20+ , lower :: [Char]

21+ , title :: [Char]

22+ , upper :: [Char]

23+ , conditions :: String

24+ , name :: String

25+ } deriving (Eq, Ord, Show)

26+

27+entries :: Parser [Case]

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

29+ where

30+ entry = Case <$> unichar <* semi

31+ <*> unichars

32+ <*> unichars

33+ <*> unichars

34+ <*> manyTill anyToken (string "# ")

35+ <*> 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"

40+

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

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

43+

44+upperFunc ms = typ ++ (map nice . filter p $ ms) ++ [last]

45+ where

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

47+ ,"{-# INLINE upperMapping #-}"]

48+ last = "upperMapping c s = Yield (toUpper c) (s :!: '\\0' :!: '\\0')"

49+ nice c = "-- " ++ name c ++ "\nupperMapping " ++ showC (code c) ++ " s = Yield " ++ x ++ " (s :!: " ++ y ++ " :!: " ++ z ++ ")"

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

51+ p c = [code c] /= upper c && null (conditions c)

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

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

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

55+

56+main = do

57+ args <- getArgs

58+ let (iname, oname) = case args of

59+ [] -> ("SpecialCasing.txt", "CaseMapping.hs")

60+ [i] -> (i, "CaseMapping.hs")

61+ [i,o] -> (i,o)

62+ p <- parseFile iname

63+ ms <- case p of

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

65+ Right ms -> return ms

66+ h <- openFile oname WriteMode

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

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

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

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

71+ ,"import Data.Char"

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

73+ ,""]

74+ mapM_ (hPutStrLn h) (upperFunc ms)

75+ hClose h

text.cabal+1

@@ -32,6 +32,7 @@ library

3232 Data.Text.Internal

3333 Data.Text.Encoding.Fusion.Common

3434 Data.Text.Fusion.Internal

35+ Data.Text.Fusion.CaseMapping

3536 Data.Text.Lazy.Internal

3637 Data.Text.Unsafe

3738 Data.Text.UnsafeChar