forked from svn2github/freearc
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Charsets.hs
445 lines (374 loc) · 19.3 KB
/
Charsets.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- Ïîääåðæêà ðàçëè÷íûõ êîäèðîâîê è ëîêàëèçàöèè èíòåðôåéñà ïðîãðàììû ----
----------------------------------------------------------------------------------------------------
-----------------------------------------------------------------------------
-- |
-- Module : Charsets
-- Copyright : (c) Bulat Ziganshin <[email protected]>
-- License : Public domain
--
-- Maintainer : [email protected]
-- Stability : experimental
-- Portability : GHC
--
-----------------------------------------------------------------------------
module Charsets where
import Prelude hiding (catch)
import Control.Concurrent
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad
import Data.Array
import Data.Char
import Data.IORef
import Data.List
import Foreign
import Foreign.C
import Foreign.Marshal.Alloc
import System.Posix.Internals
import System.Posix.Types
import System.IO
import System.IO.Error hiding (catch)
import System.IO.Unsafe
import System.Locale
import System.Time
import System.Process
import System.Directory
import System.Environment
#if defined(FREEARC_WIN)
import System.Win32
#endif
import Utils
import Files
---------------------------------------------------------------------------------------------------
---- Ãëîáàëüíûå íàñòðîéêè ïåðåêîäèðîâêè äëÿ èñïîëüçîâàíèÿ â ãëóáîêî âëîæåííûõ ôóíêöèÿõ ------------
---------------------------------------------------------------------------------------------------
-- |Translate string from internal to terminal encoding
str2terminal' = unsafePerformIO$ newIORef$ unParseData (domainTranslation aCHARSET_DEFAULTS 't')
str2terminal s = val str2terminal' >>== ($s)
-- |Translate string from terminal to internal encoding
terminal2str' = unsafePerformIO$ newIORef$ parseData (domainTranslation aCHARSET_DEFAULTS 't')
terminal2str s = val terminal2str' >>== ($s)
-- |Translate string from cmdline to internal encoding
cmdline2str' = unsafePerformIO$ newIORef$ parseData (domainTranslation aCHARSET_DEFAULTS 'p')
cmdline2str s = val cmdline2str' >>== ($s)
-- |Translate string from internal to logfile encoding
str2logfile' = unsafePerformIO$ newIORef$ unParseData (domainTranslation aCHARSET_DEFAULTS 'i')
str2logfile s = val str2logfile' >>== ($s)
-- |Îïåðàöèÿ, óñòàíàâëèâàþùàÿ ãëîáàëüíûå íàñòðîéêè ïåðåêîäèðîâêè äëÿ èñïîëüçîâàíèÿ â ãëóáîêî âëîæåííûõ ôóíêöèÿõ
setGlobalCharsets charsets = do
str2filesystem' =: unParseData (domainTranslation charsets 'f')
str2terminal' =: unParseData (domainTranslation charsets 't')
str2logfile' =: unParseData (domainTranslation charsets 'i')
terminal2str' =: parseData (domainTranslation charsets 't')
filesystem2str' =: parseData (domainTranslation charsets 'f')
cmdline2str' =: parseData (domainTranslation charsets 'p')
-- Ïîëó÷åíèå êîìàíäíîé ñòðîêè
#ifdef FREEARC_WIN
myGetArgs = do
alloca $ \p_argc -> do
p_argv_w <- commandLineToArgvW getCommandLineW p_argc
argc <- peek p_argc
argv_w <- peekArray (i argc) p_argv_w
mapM peekTString argv_w >>== tail
foreign import stdcall unsafe "windows.h GetCommandLineW"
getCommandLineW :: LPTSTR
foreign import stdcall unsafe "windows.h CommandLineToArgvW"
commandLineToArgvW :: LPCWSTR -> Ptr CInt -> IO (Ptr LPWSTR)
#else
myGetArgs = getArgs >>= mapM cmdline2str
#endif
---------------------------------------------------------------------------------------------------
---- Ïàðñåð îïöèè êîìàíäíîé ñòðîêè -sc/--charset --------------------------------------------------
---------------------------------------------------------------------------------------------------
-- |Òèï ôóíêöèè, òðàíñëèðóþùåé âõîäíûõ äàííûå çàäàííîãî òèïà â Unicode
type ParseDataFunc = Domain -> String -> String
-- |Îáðàáîòàòü ñïèñîê îïöèé --charset/-sc, âîçâðàòèâ òàáëèöó êîäèðîâîê
-- è ïðîöåäóðû ÷òåíèÿ/çàïèñè ôàéëîâ ñ å¸ ó÷¸òîì
parse_charset_option optionsList = (charsets
,parseFile . domainTranslation charsets
,unParseFile . domainTranslation charsets
,parseData . domainTranslation charsets
,unParseData . domainTranslation charsets)
where
-- Òàáëèöà êîäèðîâîê
charsets = foldl f aCHARSET_DEFAULTS optionsList
-- Ôóíêöèÿ îáðàáîòêè îïöèé --charset
f value "--" = aCHARSET_DEFAULTS -- -sc-- îçíà÷àåò âîññòàíîâèòü çíà÷åíèÿ ïî óìîë÷àíèþ
f value ('s':cs) = _7zToRAR value "l" cs -- -scs... óñòàíàâëèâàåò êîäèðîâêó äëÿ ëèñòôàéëîâ
f value ('l':cs) = _7zToRAR value "l" cs -- -scl... does the same
f value ('c':cs) = _7zToRAR value "c" cs -- -scs... óñòàíàâëèâàåò êîäèðîâêó äëÿ êîììåíòôàéëîâ
f value ('f':cs) = _7zToRAR value "f" cs -- -scf... óñòàíàâëèâàåò êîäèðîâêó äëÿ ôàéëîâîé ñèñòåìû
f value ('d':cs) = _7zToRAR value "d" cs -- -scd... óñòàíàâëèâàåò êîäèðîâêó äëÿ êàòàëîãà àðõèâà
f value ('t':cs) = _7zToRAR value "t" cs -- -sct... óñòàíàâëèâàåò êîäèðîâêó äëÿ òåðìèíàëà (êîíñîëè)
f value ('p':cs) = _7zToRAR value "p" cs -- -scp... óñòàíàâëèâàåò êîäèðîâêó äëÿ ïàðàìåòðîâ êîì. ñòðîêè
f value ('i':cs) = _7zToRAR value "i" cs -- -sci... óñòàíàâëèâàåò êîäèðîâêó äëÿ ini-ôàéëîâ (arc.ini/arc.groups)
f value (x:cs) = foldl Utils.update value [(c,x) | c<-cs|||"cl"] -- óñòàíîâèòü â `x` ýëåìåíòû ñïèñêà, ïåðå÷èñëåííûå â cs (ïî óìîë÷àíèþ 'c' è 'l')
-- Âñïîìîãàòåëüíûå ôóíêöèè, ïðåîáðàçóþùèå 7zip-îâñêèé ôîðìàò îïöèé â RAR'îâñêèé
_7zToRAR value typ cs = f value (g (strLower cs):typ)
g "utf-8" = '8'; g "win" = 'a'
g "utf8" = '8'; g "ansi" = 'a'
g "utf-16" = 'u'; g "dos" = 'o'
g "utf16" = 'u'; g "oem" = 'o'
-- Ïðîöåäóðà ÷òåíèÿ ôàéëà, òðàíñëèðóþùàÿ åãî êîäèðîâêó è ðàçáèâàþùàÿ íà îòäåëüíûå ñòðîêè
parseFile encoding file = fileGetBinary file >>== parseData encoding >>== linesCRLF
-- Ïðîöåäóðà òðàíñëÿöèè âõîäíûõ äàííûõ èç encoding â Unicode
parseData encoding = aTRANSLATE_INPUT (charsetTranslation encoding)
-- Ïðîöåäóðà çàïèñè ôàéëà, òðàíñëèðóþùàÿ äàííûå â êîäèðîâêó encoding
unParseFile encoding file = filePutBinary file . unParseData encoding
-- Ïðîöåäóðà òðàíñëÿöèè âûõîäíûõ äàííûõ èç encoding èç Unicode
unParseData encoding = aTRANSLATE_OUTPUT (charsetTranslation encoding)
-- |Ðàçáèåíèå íà ñòðîêè ôàéëà, èïîëüçóþùåãî ëþáîå ïðåäñòàâëåíèå êîíöà ñòðîêè (CR, LF, CR+LF)
linesCRLF = recursive oneline -- oneline "abc\n..." = ("abc","...")
where oneline ('\r':'\n':s) = ("",'\xFEFF':s)
oneline ('\r':s) = ("",'\xFEFF':s)
oneline ('\n':s) = ("",'\xFEFF':s)
oneline ('\xFEFF':s) = oneline s
oneline (c:s) = (c:s0,s1) where (s0,s1) = oneline s
oneline "" = ("","")
-- Áóäåì ñ÷èòàòü, ÷òî âñå GUI êîíôèã-ôàéëû õðàíÿòñÿ â UTF-8
readConfigFile = parseFile '8'
saveConfigFile file = unParseFile '8' file . joinWith "\n"
modifyConfigFile file f = readConfigFileManyTries file >>== f >>= saveConfigFile file
-- Ïðî÷èòàòü êîíôèã-ôàéë, ïîâòîðÿÿ ïîïûòêè åñëè îí ïóñò/íåäîñòóïåí
readConfigFileManyTries file = go 1 where
go attempt = do xs <- readConfigFile file `catch` (\e->return [])
if xs==[] && attempt<100
then do sleepSeconds 0.01
go (attempt+1)
else return xs
---------------------------------------------------------------------------------------------------
---- Ïîääåðæêà ðàçëè÷íûõ êîäèðîâîê äëÿ ââîäà/âûâîäà -----------------------------------------------
---------------------------------------------------------------------------------------------------
-- |Âîçâðàùàåò charset, èñïîëüçóåìûé â domainCharsets äëÿ äàííûõ òèïà domain
domainTranslation domainCharsets domain =
lookup domain domainCharsets `defaultVal` error ("Unknown charset domain "++quote [domain])
-- |Òðàíñëÿöèÿ äàííûõ, çàäàííûõ â êîäèðîâêå charset
charsetTranslation charset =
lookup charset aCHARSETS `defaultVal` error ("Unknown charset "++quote [charset])
-- |Òðàíñëÿöèÿ äàííûõ èç îáëàñòè domain (ëèñòôàéëû, êîíôèãôàéëû, êîììåíò-ôàéëû...),
-- èñïîëüçóÿ charset, çàäàííûé äëÿ íå¸ â domainÑharsets
translation domainCharsets domain =
charsetTranslation $ domainTranslation domainCharsets domain
-- Òèïû, èñïîëüçóåìûå äëÿ ïðåäñòàâëåíèÿ domain è charset
type Domain = Char
type Charset = Char
-- |Each charset is represented by pair of functions: input translation (byte sequence into Unicode String) and output translation
data TRANSLATION = TRANSLATION {aTRANSLATE_INPUT, aTRANSLATE_OUTPUT :: String->String}
-- |Character sets and functions to translate texts from/to these charsets
aCHARSETS = [ ('0', TRANSLATION id id)
, ('8', TRANSLATION utf8_to_unicode unicode2utf8)
, ('u', TRANSLATION utf16_to_unicode unicode2utf16)
] ++ aLOCAL_CHARSETS
#ifdef FREEARC_UNIX
aLOCAL_CHARSETS = []
-- |Default charsets for various domains
aCHARSET_DEFAULTS = [ ('f','8') -- filenames in filesystem: UTF-8
, ('d','8') -- filenames in archive directory: UTF-8
, ('l','8') -- filelists: UTF-8
, ('c','8') -- comment files: UTF-8
, ('t','8') -- terminal: UTF-8
, ('p','8') -- program arguments: UTF-8
, ('i','8') -- ini/group files: UTF-8
]
#else
-- |Windows-specific charsets
aLOCAL_CHARSETS = [ ('o', TRANSLATION oem2unicode unicode2oem)
, ('a', TRANSLATION ansi2unicode unicode2ansi)
]
-- |Default charsets for various domains
aCHARSET_DEFAULTS = [ ('f','u') -- filenames in filesystem: UTF-16
, ('d','8') -- filenames in archive directory: UTF-8
, ('l','o') -- filelists: OEM
, ('c','o') -- comment files: OEM
, ('t','o') -- terminal: OEM
, ('p','a') -- program arguments: ANSI
, ('i','o') -- ini/group files: OEM
]
---------------------------------------------------------------------------------------------------
---- Windows-specific codecs ----------------------------------------------------------------------
---------------------------------------------------------------------------------------------------
-- |Ïðåîáðàçîâàòü âèíäîâûå êîäû ñèìâîëîâ \r è \n â ÷åëîâå÷åñêèé âèä
iHateWindows = replace (chr 9834) '\r' . replace (chr 9689) '\n'
-- |Translate string from Unicode to OEM encoding
unicode2oem s =
if all isAscii s
then s
else unsafePerformIO $ do
withCWStringLen s $ \(wstr,len) -> do
allocaBytes len $ \cstr -> do
c_WideToOemBuff wstr cstr (i len)
peekCStringLen (cstr,len)
-- |Translate string from OEM encoding to Unicode
oem2unicode s =
if all isAscii s
then s
else iHateWindows $
unsafePerformIO $ do
withCStringLen s $ \(cstr,len) -> do
allocaBytes (len*2) $ \wstr -> do
c_OemToWideBuff cstr wstr (i len)
peekCWStringLen (wstr,len)
-- |Translate string from Unicode to ANSI encoding
unicode2ansi s =
if all isAscii s
then s
else unsafePerformIO $ do
withCWStringLen s $ \(wstr,len) -> do
allocaBytes len $ \cstr -> do
c_WideToOemBuff wstr cstr (i len)
c_OemToAnsiBuff cstr cstr (i len)
peekCStringLen (cstr,len)
-- |Translate string from ANSI encoding to Unicode
ansi2unicode s =
if all isAscii s
then s
else iHateWindows $
unsafePerformIO $ do
withCStringLen s $ \(cstr,len) -> do
allocaBytes (len*2) $ \wstr -> do
c_AnsiToOemBuff cstr cstr (i len)
c_OemToWideBuff cstr wstr (i len)
peekCWStringLen (wstr,len)
foreign import stdcall unsafe "winuser.h CharToOemBuffW"
c_WideToOemBuff :: CWString -> CString -> DWORD -> IO Bool
foreign import stdcall unsafe "winuser.h OemToCharBuffW"
c_OemToWideBuff :: CString -> CWString -> DWORD -> IO Bool
foreign import stdcall unsafe "winuser.h OemToCharBuffA"
c_OemToAnsiBuff :: CString -> CString -> DWORD -> IO Bool
foreign import stdcall unsafe "winuser.h CharToOemBuffA"
c_AnsiToOemBuff :: CString -> CString -> DWORD -> IO Bool
#endif
---------------------------------------------------------------------------------------------------
---- UTF-8, UTF-16 codecs; URL encoding -----------------------------------------------------------
---------------------------------------------------------------------------------------------------
-- |Translate string from UTF-16 encoding to Unicode
utf16_to_unicode = tryToSkip [chr 0xFEFF] . map chr . fromUTF16 . map ord
where
fromUTF16 (c1:c2:c3:c4:wcs)
| 0xd8<=c2 && c2<=0xdb && 0xdc<=c4 && c4<=0xdf =
((c1+c2*256 - 0xd800)*0x400 + (c3+c4*256 - 0xdc00) + 0x10000) : fromUTF16 wcs
fromUTF16 (c1:c2:wcs) = c1+c2*256 : fromUTF16 wcs
fromUTF16 [] = []
-- |Translate string from Unicode to UTF-16 encoding
unicode2utf16 = map chr . foldr utf16Char [] . map ord
where
utf16Char c wcs
| c < 0x10000 = c `mod` 256 : c `div` 256 : wcs
| otherwise = let c' = c - 0x10000 in
((c' `div` 0x400) .&. 0xFF) :
(c' `div` 0x40000 + 0xd8) :
(c' .&. 0xFF) :
(((c' `mod` 0x400) `div` 256) + 0xdc) : wcs
-- |Translate string from UTF-8 encoding to Unicode
utf8_to_unicode s =
if all isAscii s
then s
else (tryToSkip [chr 0xFEFF] . fromUTF' . map ord) s where
fromUTF' [] = []
fromUTF' (all@(x:xs))
| x<=0x7F = chr x : fromUTF' xs
| x<=0xBF = err
| x<=0xDF = twoBytes all
| x<=0xEF = threeBytes all
| x<=0xFF = fourBytes all
| otherwise = err
twoBytes (x1:x2:xs) = chr ((((x1 .&. 0x1F) `shift` 6) .|.
(x2 .&. 0x3F))):fromUTF' xs
twoBytes _ = error "fromUTF: illegal two byte sequence"
threeBytes (x1:x2:x3:xs) = chr ((((x1 .&. 0x0F) `shift` 12) .|.
((x2 .&. 0x3F) `shift` 6) .|.
(x3 .&. 0x3F))):fromUTF' xs
threeBytes _ = error "fromUTF: illegal three byte sequence"
fourBytes (x1:x2:x3:x4:xs) = chr ((((x1 .&. 0x0F) `shift` 18) .|.
((x2 .&. 0x3F) `shift` 12) .|.
((x3 .&. 0x3F) `shift` 6) .|.
(x4 .&. 0x3F))):fromUTF' xs
fourBytes _ = error "fromUTF: illegal four byte sequence"
err = error "fromUTF: illegal UTF-8 character"
-- |Translate string from Unicode to UTF-8 encoding
unicode2utf8 s =
if all isAscii s
then s
else go s
where go [] = []
go (x:xs) | ord x<=0x007f = chr (ord x) : go xs
| ord x<=0x07ff = chr (0xC0 .|. ((ord x `shiftR` 6) .&. 0x1F)):
chr (0x80 .|. ( ord x .&. 0x3F)):
go xs
| ord x<=0xffff = chr (0xE0 .|. ((ord x `shiftR` 12) .&. 0x0F)):
chr (0x80 .|. ((ord x `shiftR` 6) .&. 0x3F)):
chr (0x80 .|. ( ord x .&. 0x3F)):
go xs
| otherwise = chr (0xF0 .|. ( ord x `shiftR` 18)) :
chr (0x80 .|. ((ord x `shiftR` 12) .&. 0x3F)) :
chr (0x80 .|. ((ord x `shiftR` 6) .&. 0x3F)) :
chr (0x80 .|. ( ord x .&. 0x3F)) :
go xs
-- |Çàêîäèðîâàòü ñèìâîëû, çàïðåù¸ííûå â URL
urlEncode = concatMap (\c -> if isReservedChar c then '%':encode16 [c] else [c]) . unicode2utf8
where
isReservedChar x
| x >= 'a' && x <= 'z' = False
| x >= 'A' && x <= 'Z' = False
| x >= '0' && x <= '9' = False
| x <= chr 0x20 || x >= chr 0x7F = True
| otherwise = x `elem` [';','/','?',':','@','&'
,'=','+',',','$','{','}'
,'|','\\','^','[',']','`'
,'<','>','#','%', chr 34]
---------------------------------------------------------------------------------------------------
---- Internalization ------------------------------------------------------------------------------
---------------------------------------------------------------------------------------------------
{-# NOINLINE locale #-}
-- |Ëîêàëèçàöèÿ: îòîáðàæåíèå èíäåêñà â ëîêàëèçîâàííóþ ñòðîêó
locale :: IORef (Array Int (Maybe String))
locale = unsafePerformIO $ ref$ array (0,-1) []
{-# NOINLINE setLocale #-}
-- |Óñòàíîâèòü ëîêàëèçàöèþ ïî ôàéëó
setLocale "--" = return ()
setLocale localeFile = do
localeInfo <- parseLocaleFile localeFile
locale =: localeInfo
-- |Ïåðåâîäèò ñòðîêó/ñïèñîê ñòðîê íà ìåñòíûé ÿçûê
i18ns = mapM i18n
i18n = i18n' .>>== fst
i18n' = i18n_general (val locale)
{-# NOINLINE i18fmt #-}
-- |Îòôîðìàòèðîâàòü ñïèñîê ñòðîê, èñïîëüçóÿ ïåðâóþ êàê òðåáóùèé ëîêàëèçàöèè øàáëîí,
-- à îñòàëüíûå - êàê åãî àðãóìåíòû
i18fmt (x:xs) = i18n x >>== (`formatn` xs)
{-# NOINLINE parseLocaleFile #-}
-- |Ïðî÷èòàòü èç ôàéëà ñïèñîê ñòðîê ëîêàëèçàöèè
parseLocaleFile localeFile = do
-- Ïðî÷èòàåì ôàéë ëîêàëèçàöèè èëè âîçâðàòèì ïóñòóþ áîëâàíêó
localeInfo <- readConfigFile localeFile `catch` \e -> return ["0000=English"]
-- Îòáèðàåì ñòðîêè, íà÷èíàþùèåñÿ íà "dddd", è ñîçäà¸ì èç íèõ ìàññèâ: dddd -> òåêñò ïîñëå çíàêà '='
-- Åñëè òåêñò ïîñëå '=' çàêëþ÷¸í â äâîéíûå êàâû÷êè - èçáàâèìñÿ îò íèõ
-- Ñèìâîëû '&' çàìåíÿþòñÿ íà '_' (ðàçëè÷èå â àêñåëåðàòîðàõ 7-zip è Gtk)
-- \" çàìåíÿåòñÿ íà ïðîñòî ", çàïèñü "\\n" íà ñàì ñèìâîë \n
return$ localeInfo .$ filter (\s -> length s > 4 && s `contains` '=')
.$ filter (all isDigit.take 4)
.$ map (split2 '=')
.$ deleteIf (("??"==).snd)
.$ mapFsts (readInt.take 4)
.$ mapSnds (\s -> s.$ (s.$match "\"*\"" &&& (reverse.drop 1.reverse.drop 1)))
.$ mapSnds (replace '&' '_'. replaceAll "\\\"" "\"". replaceAll "\\n" "\n")
.$ populateArray Nothing Just
{-# NOINLINE i18n_general #-}
-- |Âîçâðàùàåò ëîêàëèçîâàííûé òåêñò íàäïèñè è å¸ âñïëûâàþùóþ ïîäñêàçêó
i18n_general getLocale text = do
-- Åñëè òåêñò ñîäåðæèò â íà÷àëå "dddd ", òî âåðí¸ì âìåñòî íåãî ñòðîêó ëîêàëèçàöèè çà íîìåðîì dddd
-- Åñëè òàêîé ñòðîêè íå íàéäåíî - âîçâðàòèì ïåðåäàííûé òåêñò çà âû÷åòîì "dddd "
-- Êðîìå òîãî, òåêñòû âèäà " * " ëîêàëèçóþòñÿ â àíàëîãè÷íûé âèä
case splitAt 4 text of
(d,' ':engText) | all isDigit d -> do
let f = (engText.$match " * ") &&& ((" "++).(++" "))
arr <- getLocale
let n = readInt d
g i def = if i.$inRange (bounds arr)
then fmap f (arr!i) `defaultVal` def
else def
return (g n engText, g (n+1000) "")
_ -> return (text, "")