-
Notifications
You must be signed in to change notification settings - Fork 2
/
Copy pathCompression.hs
564 lines (487 loc) · 26.6 KB
/
Compression.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
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
{-# OPTIONS_GHC -cpp #-}
----------------------------------------------------------------------------------------------------
---- Óïàêîâêà, ðàñïàêîâêà è âû÷èñëåíèå CRC. ----
---- Òèïû äàííûõ CompressionMethod, Compressor, UserCompressor - îïèñàíèå ìåòîäà ñæàòèÿ. ----
---- Èíòåðôåéñ ñ íàïèñàííûìè íà Ñè ïðîöåäóðàìè, âûïîëíÿþùèìè âñþ ðåàëüíóþ ðàáîòó. ----
----------------------------------------------------------------------------------------------------
module Compression (module Compression, CompressionLib.decompressMem) where
import Control.Concurrent
import Control.Monad
import Data.Bits
import Data.Char
import Data.IORef
import Data.List
import Data.Maybe
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Alloc
import Foreign.Marshal.Pool
import Foreign.Ptr
import System.IO.Unsafe
#ifdef FREEARC_CELS
import qualified TABI
#endif
import qualified CompressionLib
import Utils
import Errors
import Files
import qualified ByteStream
-- |Ìåòîä ñæàòèÿ èëè ïðåïðîöåññîð è åãî ïàðàìåòðû
type CompressionMethod = CompressionLib.Method
-- Ìåòîäû "ñæàòèÿ", ïîääåðæèâàåìûå íàïðÿìóþ, à íå ÷åðåç CompressionLib
aSTORING = "storing"
aFAKE_COMPRESSION = "fake"
aCRC_ONLY_COMPRESSION = "crc"
-- |Ôåéêîâûå (íåðàñïàêîâûâàåìûå) ìåòîäû ñæàòèÿ.
isFakeMethod = (==aFAKE_COMPRESSION) . method_name
-- |LZP ìåòîä ñæàòèÿ.
isLZP_Method method = method_name method == "lzp"
-- |Tornado ìåòîä ñæàòèÿ.
isTornado_Method method = method_name method == "tor"
-- |DICT ìåòîä ñæàòèÿ.
isDICT_Method method = method_name method == "dict"
-- |TTA ìåòîä ñæàòèÿ.
isTTA_Method method = method_name method == "tta"
-- |MM ìåòîä ñæàòèÿ.
isMM_Method method = method_name method == "mm"
-- |JPG ìåòîä ñæàòèÿ.
isJPG_Method method = method_name method == "jpg"
-- |GRZip ìåòîä ñæàòèÿ.
isGRZIP_Method method = method_name method == "grzip"
-- |Ìåòîä, êîòîðîìó íóæíî ïîäàâàòü ôàéëû ïî îäíîìó íà ñîëèä-áëîê (bmf, tta è òàê äàëåå)
isNonSolidMethod = CompressionLib.compressionIs "nosolid?"
-- |Î÷åíü áûñòðûé ìåòîä óïàêîâêè (>10 mb/s íà 1ÃÃö ïðîöåññîðå)
isVeryFastMethod = CompressionLib.compressionIs "VeryFast?"
-- |Áûñòðûé ìåòîä ðàñïàêîâêè
isFastDecMethod = not . any_function [(=="ppmd"), (=="ppmm"), (=="pmm"), isEXTERNAL_Method] . method_name
-- |Ìåòîä ñæàòèÿ, âûïîëíÿåìûé âíåøíåé ïðîãðàììîé
isEXTERNAL_Method = CompressionLib.compressionIs "external?"
-- |Ìåòîä ñæàòèÿ, ñîõðàíÿþùèé (ïðè óïàêîâêå/ðàñïàêîâêå, ñîîòâåòñòâåííî) âñå ïðîìåæóòî÷íûå äàííûå íà äèñêå, ÷òî ïîâçîëÿåò îñâîáîäèòü ïàìÿòü ïåðåä íà÷àëîì ðàáîòû ñëåäóþùèõ ìåòîäîâ â öåïî÷êå
isMemoryBarrier_Compression = CompressionLib.compressionIs "MemoryBarrierCompression?"
isMemoryBarrier_Decompression = CompressionLib.compressionIs "MemoryBarrierDecompression?"
-- |Ìåòîä øèôðîâàíèÿ.
isEncryption = CompressionLib.compressionIs "encryption?"
-- |Ïîñëåäîâàòåëüíîñòü àëãîðèòìîâ ñæàòèÿ, èñïîëüçóåìûõ äëÿ îáðàáîòêè äàííûõ
type Compressor = [CompressionMethod]
-- |Ìåòîä "storing" (-m0)
aNO_COMPRESSION = [aSTORING] :: Compressor
-- |Î÷åíü áûñòðîå ñæàòèå äëÿ óæå ñæàòûõ ôàéëîâ
aCOMPRESSED_METHOD = split_compressor "4$compressed"
-- |Ýòî - ôåéêîâûé êîìïðåññîð, åñëè â í¸ì ðîâíî îäèí ìåòîä ñæàòèÿ è îí - ôåéêîâûé
isFakeCompressor (method:xs) = isFakeMethod method && null xs
-- |Ýòî - fake êîìïðåññîð, åñëè â í¸ì ðîâíî îäèí ìåòîä ñæàòèÿ è îí - "fake"
isReallyFakeCompressor (method:xs) = method_name method == aFAKE_COMPRESSION && null xs
-- |Ýòî - LZP êîìïðåññîð, åñëè â í¸ì ðîâíî îäèí ìåòîä ñæàòèÿ è îí - LZP
isLZP_Compressor (method:xs) = isLZP_Method method && null xs
-- |Ýòî - î÷åíü áûñòðûé óïàêîâùèê, åñëè â í¸ì ðîâíî îäèí, î÷åíü áûñòðûé ìåòîä ñæàòèÿ.
isVeryFastCompressor (method:xs) = isVeryFastMethod method && null xs
-- |Ýòî - áûñòðûé ðàñïàêîâùèê, åñëè îí âêëþ÷àåò òîëüêî áûñòðûå ìåòîäû ðàñïàêîâêè
isFastDecompressor = all isFastDecMethod
-- |Âûáîð êîìïðåññîðà â çàâèñèìîñòè îò òèïà îáðàáàòûâàåìûõ äàííûõ.
-- Ïåðâûé ýëåìåíò ñïèñêà áåçûìÿíåí è îïèñûâàåò êîìïðåññîð, èñïîëüçóåìûé
-- ïî óìîë÷àíèþ (äëÿ ôàéëîâ âñåõ ïðî÷èõ òèïîâ, íå îïèñàííûõ â ñïèñêå ÿâíî)
type UserCompressor = [(String,Compressor)] -- ñïèñîê àññîöèàöèé òèïà "$text->m3t, $exe->m3x, $compressed->m0"
getCompressors :: UserCompressor -> [Compressor]
getCompressors = map snd
getMainCompressor :: UserCompressor -> Compressor
getMainCompressor = snd.head
-- |Ýòî - ìåòîä Storing, åñëè â í¸ì òîëüêî îäèí êîìïðåññîð aNO_COMPRESSION äëÿ ôàéëîâ âñåõ òèïîâ
isStoring ((_,compressor):xs) = compressor==aNO_COMPRESSION && null xs
-- |Ýòî - fake compression, åñëè â í¸ì òîëüêî îäèí ôåéêîâûé êîìïðåññîð äëÿ ôàéëîâ âñåõ òèïîâ
isFakeCompression ((_,compressor):xs) = isFakeCompressor compressor && null xs
-- |Ýòî - LZP compression, åñëè â í¸ì òîëüêî îäèí LZP êîìïðåññîð äëÿ ôàéëîâ âñåõ òèïîâ
isLZP_Compression ((_,compressor):xs) = isLZP_Compressor compressor && null xs
-- |Ýòî î÷åíü áûñòðàÿ óïàêîâêà, åñëè â íåé èñïîëüçóþòñÿ òîëüêî î÷åíü áûñòðûå óïàêîâùèêè äëÿ ôàéëîâ âñåõ òèïîâ
isVeryFastCompression = all (isVeryFastCompressor.snd)
-- |Ýòî áûñòðàÿ ðàñïàêîâêà, åñëè â íåé èñïîëüçóþòñÿ òîëüêî áûñòðûå ðàñïàêîâùèêè äëÿ ôàéëîâ âñåõ òèïîâ
isFastDecompression = all (isFastDecompressor.snd)
-- |Íàéòè êîìïðåññîð, íàèáîëåå ïîäõîäÿùèé äëÿ äàííûõ òèïà `ftype`.
-- Åñëè êîìïðåññîð äëÿ ôàéëîâ ýòîãî òèïà íå îïèñàí â ñïèñêå - âîçâðàòèòü êîìïðåññîð
-- ïî óìîë÷àíèþ, çàïèñàííûé â ïåðâûé ýëåìåíò ñïèñêà
findCompressor ftype list = lookup ftype list `defaultVal` snd (head list)
-- |Äëÿ çàïèñè â îãëàâëåíèå àðõèâà èíôîðìàöèè îá èñïîëüçîâàííûõ àëãîðèòìàõ ñæàòèÿ.
instance ByteStream.BufferData Compressor where
write buf x = ByteStream.write buf (join_compressor x)
read buf = ByteStream.read buf >>== split_compressor
----------------------------------------------------------------------------------------------------
----- Îïåðàöèè íàä àëãîðèòìàìè ñæàòèÿ -----
----------------------------------------------------------------------------------------------------
class Compression a where
getCompressionMem :: a -> Integer
getDecompressionMem :: a -> Integer
getMinCompressionMem :: a -> Integer
getMinDecompressionMem :: a -> Integer
getBlockSize :: a -> MemSize
getDictionary :: a -> MemSize
setDictionary :: MemSize -> a -> a
limitCompressionMem :: MemSize -> a -> a
limitDecompressionMem :: MemSize -> a -> a
limitMinDecompressionMem :: MemSize -> a -> a
limitDictionary :: MemSize -> a -> a
instance Compression CompressionMethod where
getCompressionMem =i.CompressionLib.getCompressionMem
getDecompressionMem =i.CompressionLib.getDecompressionMem
getMinCompressionMem =i.CompressionLib.getMinCompressionMem
getMinDecompressionMem =i.CompressionLib.getMinDecompressionMem
getBlockSize = CompressionLib.getBlockSize
getDictionary = CompressionLib.getDictionary
setDictionary = CompressionLib.setDictionary
limitCompressionMem = CompressionLib.limitCompressionMem
limitDecompressionMem = CompressionLib.limitDecompressionMem
limitMinDecompressionMem = CompressionLib.limitMinDecompressionMem
limitDictionary = CompressionLib.limitDictionary
instance Compression Compressor where
getCompressionMem = calcMem getCompressionMem isMemoryBarrier_Compression
getDecompressionMem = calcMem getDecompressionMem isMemoryBarrier_Decompression
getMinCompressionMem = maximum . map getMinCompressionMem
getMinDecompressionMem = maximum . map getMinDecompressionMem
getBlockSize = maximum . map getBlockSize
getDictionary = maximum . map getDictionary
setDictionary = mapLast . setDictionary
-- |Óìåíüøàåò ïîòðåáíîñòè â ïàìÿòè êàæäîãî àëãîðèòìà â öåïî÷êå äî mem è çàòåì âñòàâëÿåò ìåæäó íèìè âûçîâû tempfile òàì, ãäå íåîáõîäèìî
limitCompressionMem mem = map (limitCompressionMem mem) >>> insertTempfile getCompressionMem isMemoryBarrier_Compression mem
limitDecompressionMem mem = map (limitDecompressionMem mem) >>> insertTempfile getDecompressionMem isMemoryBarrier_Decompression mem
-- |Îãðàíè÷èâàåò àëãîðèòì òàê, ÷òîáû åãî ìîæíî áûëî ðàñïàêîâàòü â çàäàííîì îáú¸ìå ïàìÿòè
limitMinDecompressionMem mem = map (limitMinDecompressionMem mem)
limitDictionary = compressionLimitDictionary
instance Compression UserCompressor where
-- Îïðåäåëèòü ìàêñèìàëüíîå ïîòðåáëåíèå ïàìÿòè / ðàçìåð áëîêà â çàäàííîì UserCompressor
getCompressionMem = maximum . map (getCompressionMem . snd)
getDecompressionMem = maximum . map (getDecompressionMem . snd)
getMinCompressionMem = maximum . map (getMinCompressionMem . snd)
getMinDecompressionMem = maximum . map (getMinDecompressionMem . snd)
getBlockSize = maximum . map (getBlockSize . snd)
getDictionary = maximum . map (getDictionary . snd)
-- Óñòàíîâèòü ñëîâàðü / Îãðàíè÷èòü èñïîëüçóåìóþ ïðè ñæàòèè/ðàñïàêîâêå ïàìÿòü
-- ñðàçó äëÿ âñåõ ìåòîäîâ, âõîäÿùèõ â UserCompressor
setDictionary = mapSnds . setDictionary
limitCompressionMem = mapSnds . limitCompressionMem
limitDecompressionMem = mapSnds . limitDecompressionMem
limitMinDecompressionMem = mapSnds . limitMinDecompressionMem
limitDictionary = mapSnds . limitDictionary
-- |Îãðàíè÷èòü ñëîâàðè äëÿ öåïî÷êè àëãîðèòìîâ, ïðåêðàòèâ ýòî äåëàòü ïîñëå ïåðâîãî àëãîðèòìà,
-- êîòîðûé ìîæåò ñóùåñòâåííî ðàçäóòü äàííûå (òèïà precomp). Ñðåäè âíóòðåííèõ àëãîðèòìîâ
-- òàêèõ íåò, íî ìû äåðæèì ïîä ïîäîçðåíèåì âñå âíåøíèå :)
compressionLimitDictionary mem (x:xs) = new_x : (not(isEXTERNAL_Method new_x) &&& compressionLimitDictionary mem) xs
where new_x = limitDictionary mem x
compressionLimitDictionary mem [] = []
-- |Âñòàâëÿåò âûçîâû tempfile ìåæäó àëãîðèòìàìè ñæàòèÿ, ðàçáèâàÿ èõ íà "êëàñòåðà",
-- óìåùàþùèåñÿ â memory_limit+5% (ïðè ýòîì "ìàëåíüêèå" àëãîðèòìû íå äîëæíû íà÷èíàòü íîâûõ êëàñòåðîâ,
-- à external compressors îáíóëÿþò ïîòðåáëåíèå ïàìÿòè).
insertTempfile getMem isMemoryBarrier memory_limit | memory_limit==CompressionLib.aUNLIMITED_MEMORY = id
| otherwise = go (0::Double)
where go _ [] = []
go mem (x:xs) | isMemoryBarrier x = x : go 0 xs
| mem==0 = x : go newMem xs -- íå âñòàâëÿòü tempfile â íà÷àëå öåïî÷êè èëè ñðàçó çà MemoryBarrier ìåòîäîì
| mem+newMem < memlimit*1.05 = x : go (mem+newMem) xs
| otherwise = "tempfile" : x : go newMem xs
where newMem = realToFrac (getMem x)
memlimit = realToFrac memory_limit
-- |Ïîñ÷èòàòü ïîòðåáíîñòè â ïàìÿòè öåïî÷êè àëãîðèòìîâ ñæàòèÿ ñ ó÷¸òîì èõ ðàçáèåíèÿ íà êëàñòåðû ïî compressionIs "external?"
calcMem getMem isMemoryBarrier = maximum . map (sum.map(i.getMem)) . splitOn isMemoryBarrier
-- |Óäàëÿåò âñå óïîìèíàíèÿ î "tempfile" èç çàïèñè àëãîðèòìà ñæàòèÿ.
compressionDeleteTempCompressors = filter (/="tempfile")
----------------------------------------------------------------------------------------------------
----- (De)compression of data stream -----
----------------------------------------------------------------------------------------------------
-- |Ïðîöåäóðû óïàêîâêè äëÿ ðàçëè÷íûõ àëãîðèòìîâ ñæàòèÿ.
freearcCompress num method | isFakeMethod method = eat_data
freearcCompress num method = CompressionLib.compress method
-- |Ïðîöåäóðû ðàñïàêîâêè äëÿ ðàçëè÷íûõ àëãîðèòìîâ ñæàòèÿ.
freearcDecompress num = CompressionLib.decompress
-- |×èòàåì âñ¸, íå ïèøåì íè÷åãî, à CRC ñ÷èòàåòñÿ â äðóãîì ìåñòå ;)
eat_data callback = do
allocaBytes aBUFFER_SIZE $ \buf -> do -- èñïîëüçóåì `alloca`, ÷òîáû àâòîìàòè÷åñêè îñâîáîäèòü âûäåëåííûé áóôåð ïðè âûõîäå
let go = do
#ifdef FREEARC_CELS
len <- TABI.call (\a->fromIntegral `fmap` callback a) [TABI.Pair "request" "read", TABI.Pair "buf" buf, TABI.Pair "size" (aBUFFER_SIZE::MemSize)]
#else
len <- callback "read" buf aBUFFER_SIZE
#endif
if (len>0)
then go
else return len -- Âîçâðàòèì 0, åñëè äàííûå êîí÷èëèñü, è îòðèöàòåëüíîå ÷èñëî, åñëè ïðîèçîøëà îøèáêà/áîëüøå äàííûõ íå íóæíî
go -- âîçâðàòèòü ðåçóëüòàò
----------------------------------------------------------------------------------------------------
----- CRC calculation ------------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |CRC ôàéëà
type CRC = CUInt
aINIT_CRC = 0xffffffff :: CRC
updateCRC addr len = c_UpdateCRC addr (i len)
finishCRC = xor aINIT_CRC
-- |Ïîñ÷èòàòü CRC äàííûõ â áóôåðå
calcCRC addr len = updateCRC addr len aINIT_CRC >>== finishCRC
-- |Ïîñ÷èòàòü CRC íå-unicode ñòðîêè (ñèìâîëû ñ êîäàìè 0..255)
crc32 str = unsafePerformIO$ withCStringLen str (uncurry calcCRC)
-- |Fast C routine for CRC-32 calculation
foreign import ccall safe "Environment.h UpdateCRC"
c_UpdateCRC :: Ptr CChar -> CUInt -> CRC -> IO CRC
-------------------------------------------------------------------------------------------------------------
-- Encode/decode compression method for parsing options/printing info about selected compression method -----
-------------------------------------------------------------------------------------------------------------
-- |Parse command-line option that represents compression method.
-- Äåêîäèðîâàòü çàïèñü ìåòîäà ñæàòèÿ â âèäå òåêñòîâîé ñòðîêè, ïðåâðàòèâ åãî â ñïèñîê àññîöèàöèé
-- "òèï ôàéëà -> ìåòîä ñæàòèÿ". Ïåðâûé ýëåìåíò ýòîãî ñïèñêà îïèñûâàåò ìåòîä ñæàòèÿ ïî óìîë÷àíèþ
decode_method cpus configuredMethodSubsts str =
str -- "3/$obj=2b/$iso=ecm+3b"
.$ select_full_by cpus -- ïåðåêëþ÷åíèå ìåòîäîâ ñæàòèÿ â çàâèñèìîñòè îò ÷èñëà ÿäåð/ïðîöåññîðîâ
.$ subst list -- "3b/3t/$obj=2b/$iso=ecm+3b"
.$ split_to_methods -- [("","exe+3b"), ("$obj","3b"), ("$text","3t"), ("$obj","2b"), ("$iso","ecm+3b")]
.$ keepOnlyLastOn fst -- [("","exe+3b"), ("$text","3t"), ("$obj","2b"), ("$iso","ecm+3b")]
.$ mapSnds (select_full_by cpus)
.$ mapSnds (subst2 list) -- [("",["exe","lzma"]), ("$text",["ppmd"]), ("$obj",["lzma"]), ("$iso",["ecm","lzma"])]
.$ filter (not.null.snd) -- "-m$bmp=" îçíà÷àåò çàïðåòèòü èñïîëüçîâàíèå ñïåöèàëüíîãî àëãîðèòìà äëÿ ãðóïïû $bmp
where list = prepareSubsts (concatMap reorder [configuredMethodSubsts, builtinMethodSubsts]) -- ñíà÷àëà ïîëüçîâàòåëüñêèå çàìåíû, çàòåì âñòðîåííûå, ÷òîáû äàòü ïåðâûì ïðèîðèòåò
.$ mapSnds (select_full_by cpus)
reorder list = a++b where (a,b) = partition (notElem '#') list -- âíóòðè ýòèõ ãðóïï: ñíà÷àëà ñòðî÷êè, íå ñîäåðæàùèå #, çàòåì ñ # (ñíà÷àëà êîíêðåòíûå, çàòåì îáùèå çàìåíû)
-- |Àíàëîãè÷íî select_by, íî ïîçâîëÿåò ãëîáàëüíóþ çàìåíó áåç âíåøíèõ ñêîáîê
select_full_by cpus s = select_by cpus ("("++s++")")
-- |Âûáðàòü èç çàïèñè a|b|c ìåòîä ñæàòèÿ, ñîîòâåòñòâóþùèé êîëè÷åñòâó ïðîöåññîðîâ â ñèñòåìå
select_by cpus = parse "" where
-- Îáðàáîòêà ìíîæåñòâåííûõ è âëîæåííûõ ñêîáîê òèïà (a|b)(c|d(e|f))
parse acc rest = case rest of
'(':xs -> parse acc (parse "" xs)
')':xs -> multi (reverse acc) ++ xs
"" -> reverse acc
x:xs -> parse (x:acc) xs
-- Âûáîð îäíîé èç àëüòåðíàòèâ ïî êîëè÷åñòâó cpu: (A|B||D) îçíà÷àåò ìåòîä A äëÿ cpu=1, B äëÿ cpu=2 èëè 3, D äëÿ cpu>=4
multi s = (repeater ""$ split '|' s) !! (cpus-1)
-- Ïîâòîðÿåò ýëåìåíòû â ñïèñêå äëÿ multi: (A|B||D) -> (A|B|B|D|D|D...)
repeater last ss = case ss of
("":xs) -> last : repeater last xs
(x :xs) -> x : repeater x xs
[] -> repeat last
-- Çàìåíà ïî ñïèñêó äëÿ ìåòîäà ñæàòèÿ (îáîáù¸ííîãî îáîçíà÷åíèÿ äëÿ ôàéëîâ âñåõ òèïîâ)
subst list method = joinWith "/" (main_methods:group_methods++user_methods)
where -- Èç çàïèñè òèïà -m3/$obj=2b âûäåëÿåì äëÿ ðàñøèôðîâêè òîëüêî ïåðâóþ ÷àñòü, äî ñëåøà
main:user_methods = split '/' method
-- Ðàñøèôðîâêà îñíîâíûõ ìåòîäîâ ñæàòèÿ, òèïà 3x = 3xb/3xt
main_methods = case (lookup main list) of
Just x -> subst list x -- Ïðè óñïåõå ïîâòîðÿåì ðåêóðñèâíî
Nothing -> main -- Áîëüøå ïîäñòàíîâîê íåò
-- Íàéä¸ì â ñïèñêå ïîäñòàíîâîê äîïîëíèòåëüíûå ìåòîäû ñæàòèÿ äëÿ îòäåëüíûõ ãðóïï, òèïà 3x$iso = ecm+exe+3xb
group_methods = list .$ keepOnlyFirstOn fst -- óäàëèì ïîâòîðíûå îïðåäåëåíèÿ (íå î÷åíü ýôôåêòèâíî äåëàòü ýòî èìåííî çäåñü, çàòî ïî ìåñòó èñïîëüçîâàíèÿ)
.$ mapMaybe (startFrom main . join2 "=") -- îñòàâèì òîëüêî îïðåäåëåíèÿ, íà÷èíàþùèåñÿ ñ 3x, óäàëèâ ýòî 3x
.$ filter (("$"==).take 1) -- à èç íèõ - òîëüêî íà÷èíàþùèåñÿ ñ $
-- Çàìåíà ïî ñïèñêó äëÿ àëãîðèòìà ñæàòèÿ (ïîñë-òè êîìïðåññîðîâ äëÿ êîíêðåòíîãî òèïà ôàéëîâ)
subst2 list "" = []
subst2 list method = concatMap f (split_compressor method)
where f method = let (head,params) = break (==':') method
in case (lookup head list) of
Just new_head -> subst2 list (new_head++params)
Nothing -> [decode_one_method method]
-- |Äåêîäèðîâàòü ÿâíî îïèñàííûé ìåòîä ñæàòèÿ.
decode_one_method method | isFakeMethod method = method
| otherwise = CompressionLib.canonizeCompressionMethod method
-- Ïðåâðàùàåò äëèííóþ ñòðîêó, îïèñûâàþùóþ ìåòîäû ñæàòèÿ äëÿ ðàçíûõ òèïîâ ôàéëîâ,
-- â ìàññèâ àññîöèàöèé (òèï ôàéëà, ìåòîä ñæàòèÿ)
split_to_methods method = case (split '/' method) of
[_] -> [("",method)] -- îäèí ìåòîä äëÿ ôàéëîâ âñåõ òèïîâ
x : xs@ (('$':_):_) -> ("",x) : map (split2 '=') xs -- m1/$type=m2...
b : t : xs -> [("","exe+"++b), ("$obj",b), ("$text",t)] ++ map (split2 '=') xs -- m1/m2/$type=m3...
-- Ïîäãîòîâèòü ñïèñîê çàìåí ê èñïîëüçîâàíèþ â lookup
prepareSubsts x = x
-- Óäàëèòü ïóñòûå ñòðîêè, ïðîáåëû è êîììåíòàðèè
.$ map (filter (not.isSpace) . fst . split2 ';') .$ filter (not.null)
-- Çàìåíèòü êàæäóþ ñòðîêó ñ ñèìâîëîì # íà 9 ñòðîê, ãäå # ïðîáåãàåò çíà÷åíèÿ îò 1 äî 9
.$ concatMap (\s -> if s `contains` '#' then map (\d->replace '#' d s) ['1'..'9'] else [s])
-- Ïðåîáðàçîâàòü ñïèñîê ñòðîê âèäà "a=b" â ñïèñîê äëÿ lookup
.$ map (split2 '=')
-- Âñòðîåííûå îïèñàíèÿ ìåòîäîâ ñæàòèÿ â ôîðìàòå, àíàëîãè÷íîì èñïîëüçóåìîìó â arc.ini
builtinMethodSubsts = [
";High-level method definitions"
, "x = 9 ;highest compression mode using only internal algorithms"
, "ax = 9p ;highest compression mode involving external compressors"
, "0 = storing"
, "1 = 1b"
, "1x = 1"
, "# = #rep+exe+#xb / $obj=#b / $text=#t"
, "#x = #xb/#xt"
, ""
, ";Text files compression with slow decompression"
, "1t = 1b"
, "2t = grzip:m4:8m:32:h15 | ex2t"
, "3t = dict:p: 64m:85% + lzp: 64m: 24:h20 :92% + grzip:m3:8m:l | ex3t"
, "4t = dict:p: 64m:80% + lzp: 64m: 65:d1m:s16:h20:90% + ppmd:8:96m | ex4t"
, "5t = dict:p: 64m:80% + lzp: 80m:105:d1m:s32:h22:92% + ppmd:12:192m | ex5t"
, "#t = dict:p:128m:80% + lzp:160m:145:d1m:s32:h23:92% + ppmd:16:384m"
, ""
, ";Binary files compression with slow and/or memory-expensive decompression"
, "#b = #rep+#bx"
, "1rep = rep: 96m:256:c256"
, "2rep = rep: 96m:256:c256"
, "3rep = rep: 96m"
, "4rep = rep: 96m"
, "5rep = rep: 96m"
, "6rep = rep: 256m"
, "7rep = rep: 512m"
, "8rep = rep:1024m"
, "9rep = rep:2040m"
, ""
, ";Text files compression with fast decompression"
, "1xt = 1xb"
, "2xt = 2xb"
, "3xt = dict: 64m:80% + tor:7:96m:h64m"
, "4xt = dict: 64m:75% + 4binary"
, "#xt = dict: 128m:75% + #binary"
, ""
, ";Binary files compression with fast decompression"
, "1xb = 1binary"
, "2xb = 2binary"
, "#xb = delta + #binary"
, ""
, ";Binary files compression with fast decompression"
, "1binary = tor:4 | ex1binary"
, "2binary = tor:6 | ex2binary"
, "3binary = lzma: 96m:fast :32:mc4 | ex3binary"
, "4binary = lzma: 96m:normal:16:mc8 | | ex4binary"
, "5binary = lzma: 96m:normal:32:mc32 | | ex5binary"
, "6binary = lzma: 32m:max"
, "7binary = lzma: 64m:max"
, "8binary = lzma:128m:max"
, "9binary = lzma:254m:max"
, ""
, ";One more family of methods providing fast but memory-hungry decompression: -m1d, -m2d..."
, "#d = #rep+exe+#xb / $obj=#b / $text=dict+#b / $compressed = #$compressed / $wav = #x$wav / $bmp = #x$bmp"
, ""
, ";Synonyms"
, "bcj = exe"
, "#bx = #xb"
, "#tx = #xt"
, "x# = #x" -- ïðèíèìàåì îïöèè òèïà "-mx7" äëÿ ìèìèêðèè ïîä 7-zip
, "copy = storing"
, "exe2 = dispack"
, "dispack = dispack070"
, ""
, ""
, ";Sound wave files are best compressed with TTA"
, "wav = tta ;best compression"
, "wavfast = tta:m1 ;faster compression and decompression"
, "1$wav = ;;; wavfast | bmpfastest"
, "2$wav = wavfast"
, "#$wav = wav"
, "#x$wav = wavfast"
, ""
, ";Bitmap graphic files are best compressed with GRZip"
, "bmp = mm + grzip:m1:l2048:a ;best compression"
, "bmpfast = mm + grzip:m4:l:a ;faster compression"
, "bmpfastest = mm:d1 + 1binary:t0 ;fastest one"
, "1$bmp = ;;; bmpfastest"
, "2$bmp = bmpfastest | bmpfast"
, "3$bmp = bmpfast | bmp"
, "#$bmp = bmp"
, "1x$bmp = bmpfastest"
, "2x$bmp = bmpfastest"
, "#x$bmp = mm+#binary"
, ""
, ";Quick & dirty compression for already compressed data"
, "1$compressed = storing | 1rep"
, "2$compressed = 2rep + 1binary"
, "3$compressed = 3rep + 1binary"
, "4$compressed = 4rep + etor:c3"
, "#$compressed = "
, ""
, "1x$compressed = storing | 1rep"
, "2x$compressed = 2rep:8m + 1binary"
, "3x$compressed = 3rep:8m + 1binary"
, "4x$compressed = etor:8m:c3"
, "#x$compressed = "
, ""
, ";LZ4 support"
, "xlz4 = 4x4:lz4"
, "elz4 = (|x)lz4"
, "lz4hc = lz4:hc"
, "xlz4hc = 4x4:lz4:hc"
, "elz4hc = (|x)lz4hc"
, ""
, ""
, ";Multi-threading compression modes"
, "xtor = 4x4:tor"
, "xlzma = 4x4:lzma"
, "xppmd = 4x4:b7mb:ppmd"
, "etor = (|x)tor"
, "elzma = (|x)lzma"
, "eppmd = (|x)ppmd"
, ""
, "ex1 = ex1b / $wav=mm:d1+ex1b:t0 / $bmp=mm:d1+ex1b:t0 / $compressed = #$compressed"
, "ex# = #rep+exe+ex#b / $obj=#rep+ex#b / $text=ex#t / $wav = #$wav / $bmp = #$bmp / $compressed = #$compressed"
, "#ex = ex#"
, ""
, "ex1b = ex1binary"
, "ex2b = ex2binary"
, "ex#b = delta + ex#binary"
, ""
, "ex1binary = xtor:3:8mb"
, "ex2binary = xtor:5"
, "ex3binary = xlzma:96mb:fast :32:mc4"
, "ex4binary = xlzma:96mb:normal:16:mc8"
, "ex5binary = xlzma:96mb:normal:32:mc32"
, "ex6binary = 4x4:i0:lzma: 8mb:max"
, "ex7binary = 4x4:i0:lzma:16mb:max"
, "ex8binary = 4x4:i0:lzma:32mb:max"
, "ex9binary = 4x4:i0:lzma:64mb:max"
, ""
, "ex1t = ex1b"
, "ex2t = grzip:m4"
, "ex3t = grzip:m2"
, "ex4t = grzip:m1" -- dict:p: 64m:80% + lzp: 8m: 45:d1m:s16:h15:92% + xppmd:6:48m
, "ex5t = dict:p: 64m:80% + lzp: 64m: 65:d1m:s32:h22:90% + xppmd:8:96m"
, "ex6t = dict:p: 64m:80% + lzp: 80m:105:d1m:s32:h22:92% + xppmd:12:192m"
, "ex#t = dict:p:128m:80% + lzp:160m:145:d1m:s32:h23:92% + xppmd:16:384m"
]
-- |Ìóëüòèìåäèéíûé òèï ôàéëîâ?
isMMType x = x `elem` words "$wav $bmp"
-- |Â íåêîòîðîì ñìûñëå îáðàòíàÿ îïåðàöèÿ - óãàäûâàíèå òèïà ôàéëà ïî åãî êîìïðåññîðó
typeByCompressor c = case (map method_name c) of
xs | xs `contains` "tta" -> "$wav"
| xs `contains` "mm" -> "$bmp"
| xs `contains` "grzip" -> "$text"
| xs `contains` "ppmd" -> "$text"
| xs `contains` "pmm" -> "$text"
| xs `contains` "dict" -> "$text"
| xs == aNO_COMPRESSION -> "$compressed"
| xs == ["rep","tor"] -> "$compressed"
| xs `contains` "ecm" -> "$iso"
| xs `contains` "precomp" -> "$precomp"
| xs == ["precomp","rep"] -> "$jpgsolid"
| xs `contains` "jpg" -> "$jpg"
| xs `contains` "exe" -> "$binary"
| xs `contains` "lzma" -> "$obj"
| xs `contains` "tor" -> "$obj"
| otherwise -> "default"
-- |Ñïèñîê âñåõ òèïîâ ôàéëîâ, îáíàðóæèâàåìûõ ïîäîáíûì îáðàçîì
typesByCompressor = words "$wav $bmp $text $compressed $iso $precomp $jpgsolid $jpg $obj $binary $exe"
-- |Human-readable description of compression method
encode_method uc = joinWith ", " (map encode_one_method uc)
encode_one_method (group,compressor) = between group " => " (join_compressor compressor)
join_compressor = joinWith "+"
-- |Opposite to join_compressor (used to read compression method from archive file)
split_compressor = split '+'
-- |Îáðàáîòàòü àëãîðèòìû â êîìïðåññîðå èìïåðàòèâíîé îïåðàöèåé process
process_algorithms process compressor = do
return (split_compressor compressor)
>>= mapM process
>>== join_compressor
-- |Ñîåäåíèòü ìåòîä ñæàòèÿ èç åãî íàçâàíèÿ è ïàðàìåòðîâ
join_method = joinWith ":"
-- |Ðàçáèòü ìåòîä ñæàòèÿ íà çàãîëîâîê è îòäåëüíûå ïàðàìåòðû
split_method = split ':'
-- |Èìÿ ìåòîäà ñæàòèÿ.
method_name = head . split_method
-- |Ñòðîêà, èíôîðìèðóþùàÿ ïîëüçîâàòåëÿ îá èñïîëüçóåìîì îáú¸ìå ïàìÿòè
showMem 0 = "0b"
showMem mem = showM [(gb,"gb"),(mb,"mb"),(kb,"kb"),(b,"b"),error"showMem"] mem
showMemory 0 = "0 bytes"
showMemory mem = showM [(gb," gbytes"),(mb," mbytes"),(kb," kbytes"),(b," bytes"),error"showMemory"] mem
showM xs@( (val,str) : ~(nextval,_) : _) mem =
if mem `mod` val==0 || mem `div` nextval>=4096
then show((mem+val`div` 2) `div` val)++str
else showM (tail xs) mem
-- |Îêðóãëèòü îáú¸ì ïàìÿòè ââåðõ òàê, ÷òîáû îí ïðèîáð¸ë ÷èòàáåëüíîñòü
roundMemUp mem | mem>=4096*kb = mem `roundUp` mb
| otherwise = mem `roundUp` kb
{-# NOINLINE builtinMethodSubsts #-}
{-# NOINLINE decode_method #-}
{-# NOINLINE showMem #-}