Compression.hs

----------------------------------------------------------------------------------------------------
---- Óïàêîâêà, ðàñïàêîâêà è âû÷èñëåíèå 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

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             =  any_function [==aFAKE_COMPRESSION, ==aCRC_ONLY_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"
-- |Î÷åíü áûñòðûé ìåòîä óïàêîâêè (>10 mb/s íà 1ÃÃö ïðîöåññîðå)
isVeryFastMethod         =  CompressionLib.compressionIs "VeryFast?"
-- |Áûñòðûé ìåòîä ðàñïàêîâêè
isFastDecMethod          =  not . any_function [=="ppmd", =="ppmm", =="pmm", isEXTERNAL_Method] . method_name
-- |Ìåòîä ñæàòèÿ, âûïîëíÿåìûé âíåøíåé ïðîãðàììîé
isEXTERNAL_Method        =  CompressionLib.compressionIs "external?"
-- |Ìåòîä øèôðîâàíèÿ.
isEncryption             =  CompressionLib.compressionIs "encryption?"


-- |Ïîñëåäîâàòåëüíîñòü àëãîðèòìîâ ñæàòèÿ, èñïîëüçóåìûõ äëÿ îáðàáîòêè äàííûõ
type Compressor = [CompressionMethod]

-- |Ìåòîä "storing" (-m0)
aNO_COMPRESSION = [aSTORING] :: Compressor

-- |Î÷åíü áûñòðîå ñæàòèå äëÿ óæå ñæàòûõ ôàéëîâ
aCOMPRESSED_METHOD = split_compressor "tor:8m:c3"

-- |Ýòî - ôåéêîâûé êîìïðåññîð, åñëè â í¸ì ðîâíî îäèí ìåòîä ñæàòèÿ è îí - ôåéêîâûé
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
  getBlockSize                   :: a -> MemSize
  getDictionary                  :: a -> MemSize
  setDictionary                  :: MemSize -> a -> a
  limitCompressionMem            :: MemSize -> a -> a
  limitDecompressionMem          :: MemSize -> a -> a
  limitDictionary                :: MemSize -> a -> a
  limitCompressionMemoryUsage    :: MemSize -> a -> a
  limitDecompressionMemoryUsage  :: MemSize -> a -> a

-- |Ïðåâðàòèòü ôóíêöèþ èç CompressionLib, èçìåíÿþùóþ Method, â ôóíêöèþ, èçìåíÿþùóþ CompressionMethod
liftSetter action  method | aSTORING ==  method   =  method
liftSetter action  method | isFakeMethod method   =  method
liftSetter action  method                         =  action method

-- |Ïðåâðàòèòü ôóíêöèþ èç CompressionLib, îïðàøèâàþùóþ Method, â ôóíêöèþ, îïðàøèâàþùóþ CompressionMethod
liftGetter action  method | aSTORING ==  method   =  0
liftGetter action  method | isFakeMethod method   =  0
liftGetter action  method                         =  action method

instance Compression CompressionMethod where
  getCompressionMem              =i.liftGetter   CompressionLib.getCompressionMem
  getDecompressionMem            =i.liftGetter   CompressionLib.getDecompressionMem
  getBlockSize                   =  liftGetter   CompressionLib.getBlockSize
  getDictionary                  =  liftGetter   CompressionLib.getDictionary
  setDictionary                  =  liftSetter . CompressionLib.setDictionary
  limitCompressionMem            =  liftSetter . CompressionLib.limitCompressionMem
  limitDecompressionMem          =  liftSetter . CompressionLib.limitDecompressionMem
  limitDictionary                =  liftSetter . CompressionLib.limitDictionary
  limitCompressionMemoryUsage    =  limitCompressionMem
  limitDecompressionMemoryUsage  =  const id

instance Compression Compressor where
  getCompressionMem              =  calcMem getCompressionMem
  getDecompressionMem            =  calcMem getDecompressionMem
  getBlockSize                   =  maximum . map getBlockSize
  getDictionary                  =  maximum . map getDictionary
  setDictionary                  =  mapLast . setDictionary
  limitCompressionMem            =  map . limitCompressionMem
  limitDecompressionMem          =  map . limitDecompressionMem
  limitDictionary                =  compressionLimitDictionary
  limitCompressionMemoryUsage    =  compressionLimitMemoryUsage
  limitDecompressionMemoryUsage  =  genericLimitMemoryUsage getDecompressionMem

instance Compression UserCompressor where
  -- Îïðåäåëèòü ìàêñèìàëüíîå ïîòðåáëåíèå ïàìÿòè / ðàçìåð áëîêà â çàäàííîì UserCompressor
  getCompressionMem              =  maximum . map (getCompressionMem   . snd)
  getDecompressionMem            =  maximum . map (getDecompressionMem . snd)
  getBlockSize                   =  maximum . map (getBlockSize        . snd)
  getDictionary                  =  maximum . map (getDictionary       . snd)
  -- Óñòàíîâèòü ñëîâàðü / Îãðàíè÷èòü èñïîëüçóåìóþ ïðè ñæàòèè/ðàñïàêîâêå ïàìÿòü
  -- ñðàçó äëÿ âñåõ ìåòîäîâ, âõîäÿùèõ â UserCompressor
  setDictionary                  =  mapSnds . setDictionary
  limitCompressionMem            =  mapSnds . limitCompressionMem
  limitDecompressionMem          =  mapSnds . limitDecompressionMem
  limitDictionary                =  mapSnds . limitDictionary
  limitCompressionMemoryUsage    =  mapSnds . limitCompressionMemoryUsage
  limitDecompressionMemoryUsage  =  mapSnds . limitDecompressionMemoryUsage


-- |Ìèíèìàëüíûé îáú¸ì ïàìÿòè, íåîáõîäèìûé äëÿ óïàêîâêè/ðàñïàêîâêè
compressorGetShrinkedCompressionMem    = maximum . map (compressionGetShrinkedCompressionMem . snd)
compressorGetShrinkedDecompressionMem  = maximum . map (compressionGetShrinkedDecompressionMem . snd)
compressionGetShrinkedCompressionMem    = maximum . map getCompressionMem
compressionGetShrinkedDecompressionMem  = maximum . map getDecompressionMem

-- |Îãðàíè÷èòü ñëîâàðè äëÿ öåïî÷êè àëãîðèòìîâ, ïðåêðàòèâ ýòî äåëàòü ïîñëå ïåðâîãî àëãîðèòìà,
-- êîòîðûé ìîæåò ñóùåñòâåííî ðàçäóòü äàííûå (òèïà precomp). Ñðåäè âíóòðåííèõ àëãîðèòìîâ
-- òàêèõ íåò, íî ìû äåðæèì ïîä ïîäîçðåíèåì âñå âíåøíèå :)
compressionLimitDictionary mem (x:xs) =  new_x : (not(isEXTERNAL_Method new_x)  &&&  compressionLimitDictionary mem) xs
                                             where new_x = limitDictionary mem x
compressionLimitDictionary mem []     =  []

-- |Óìåíüøàåò ïîòðåáíîñòè â ïàìÿòè êàæäîãî àëãîðèòìà â öåïî÷êå äî mem
-- è çàòåì âñòàâëÿåò ìåæäó íèìè âûçîâû tempfile, åñëè íåîáõîäèìî
compressionLimitMemoryUsage mem  =  genericLimitMemoryUsage getCompressionMem mem . map (limitCompressionMem mem)

-- |Âñòàâëÿåò âûçîâû tempfile ìåæäó àëãîðèòìàìè ñæàòèÿ, ðàçáèâàÿ èõ íà "êëàñòåðà",
-- óìåùàþùèåñÿ â memory_limit+5% (ïðè ýòîì "ìàëåíüêèå" àëãîðèòìû íå äîëæíû íà÷èíàòü íîâûõ êëàñòåðîâ).
-- Ïðè ýòîì äëÿ dict/dict+lzp èñïîëüçóåòñÿ îñîáûé ó÷¸ò ïàìÿòè (blocksize*2 íà îáà, blocksize/2 íà âûõîäå),
-- à external compressors îáíóëÿþò ïîòðåáëåíèå ïàìÿòè
genericLimitMemoryUsage getMem memory_limit = go (0::Double) ""
  where go _   _    []      =  []
        go mem prev (x:xs) | isEXTERNAL_Method x          =  x: go 0            x xs
                           | mem+newMem < memlimit*1.05   =  x: go (mem+newMem) x xs
                           | otherwise                    =  "tempfile":x: go newMem x xs

           where newMem | mem==0 && isDICT_Method x             =  realToFrac (getBlockSize x) / 2
                        | isDICT_Method prev && isLZP_Method x  =  0
                        | otherwise                             =  realToFrac$ getMem x
                 memlimit = realToFrac memory_limit

-- |Ïîñ÷èòàòü ïîòðåáíîñòè â ïàìÿòè öåïî÷êè àëãîðèòìîâ ñæàòèÿ ñ ó÷¸òîì èõ ðàçáèåíèÿ.
-- íà êëàñòåðû ïî compressionIs "external?" è îñîáûì ó÷¸òîì dict/dict+lzp
calcMem getMem  = maximum . map getMemSum . splitOn isEXTERNAL_Method
  where getMemSum (x:y:xs) | isDICT_Method x && isLZP_Method y  =  max (i$ getMem x) (i(getBlockSize x `div` 2) + getMemSum xs)
        getMemSum (x:xs)   | isDICT_Method x                    =  max (i$ getMem x) (i(getBlockSize x `div` 2) + getMemSum xs)
        getMemSum (x:xs)                                        =  i(getMem x) + getMemSum xs
        getMemSum []                                            =  0::Integer

-- |Óäàëÿåò âñå óïîìèíàíèÿ î "tempfile" èç çàïèñè àëãîðèòìà ñæàòèÿ.
compressionDeleteTempCompressors = filter (/="tempfile")


----------------------------------------------------------------------------------------------------
----- (De)compression of data stream                                                           -----
----------------------------------------------------------------------------------------------------

{-
compress   method callback      - óïàêîâàòü äàííûå
decompress method callback      - ðàñïàêîâàòü äàííûå

  method :: CompressionMethod - àëãîðèòì óïàêîâêè
  callback "read" buf size - ïðî÷èòàòü âõîäíûå äàííûå â áóôåð `buf` äëèíîé `size`
                             Âîçâðàùàåò 0   - êîíåö äàííûõ
                                        <0  - ïðåðâàòü (ðàñ)ïàêîâêó (îøèáêà èëè áîëüøå äàííûõ íå íóæíî)
                                        >0  - êîë-âî ïðî÷èòàííûõ áàéò
  callback "write" buf size - çàïèñàòü âûõîäíûå äàííûå
                              Âîçâðàùàåò <0  - ïðåðâàòü (ðàñ)ïàêîâêó (îøèáêà èëè áîëüøå äàííûõ íå íóæíî)
                                         >=0 - âñ¸ îê
                              Ïðè âîçâðàùåíèè èç ýòîé ôóíêöèè äàííûå äîëæíû áûòü "èñïîëüçîâàíû", ïîòîìó ÷òî
                                (ðàñ)ïàêîâùèê ìîæåò íà÷àòü çàïèñü íîâûõ äàííûõ íà òî æå ìåñòî
Âõîäíûå è âûõîäíûå áóôåðà âûäåëÿþòñÿ è îñâîáîæäàþòñÿ (ðàñ)ïàêîâùèêîì
-}

-- |Ïðîöåäóðû óïàêîâêè äëÿ ðàçëè÷íûõ àëãîðèòìîâ ñæàòèÿ.
freearcCompress   num method | aSTORING ==  method =  copy_data
freearcCompress   num method | isFakeMethod method =  eat_data
freearcCompress   num method                       =  CompressionLib.compress method

-- |Ïðîöåäóðû ðàñïàêîâêè äëÿ ðàçëè÷íûõ àëãîðèòìîâ ñæàòèÿ.
freearcDecompress num method | aSTORING ==  method =  copy_data
freearcDecompress num method | isFakeMethod method =  impossible_to_decompress   -- ýòè òèïû ñæàòûõ äàííûõ íå ïîäëåæàò ðàñïàêîâêå
freearcDecompress num method                       =  CompressionLib.decompress method

-- |Êîïèðîâàíèå äàííûõ áåç ñæàòèÿ (-m0)
copy_data callback = do
  allocaBytes aHUGE_BUFFER_SIZE $ \buf -> do  -- èñïîëüçóåì `alloca`, ÷òîáû àâòîìàòè÷åñêè îñâîáîäèòü âûäåëåííûé áóôåð ïðè âûõîäå
    let go ptr = do
          len <- callback "read" ptr ((buf+:aHUGE_BUFFER_SIZE)-:ptr)
          if (len>0)
            then do let newptr = ptr+:len
                    if newptr < buf+:aHUGE_BUFFER_SIZE
                       then go newptr
                       else do result <- callback "write" buf (newptr-:buf)
                               if (result>=0)
                                 then go buf
                                 else return (result)  -- Âîçâðàòèì îòðèöàòåëüíîå ÷èñëî, åñëè ïðîèçîøëà îøèáêà/áîëüøå äàííûõ íå íóæíî
            else do if (len==0 && ptr>buf)
                      then do result <-  callback "write" buf (ptr-:buf)
                              return (if result>0 then 0 else result)
                      else return len  -- Âîçâðàòèì 0, åñëè äàííûå êîí÷èëèñü, è îòðèöàòåëüíîå ÷èñëî, åñëè ïðîèçîøëà îøèáêà/áîëüøå äàííûõ íå íóæíî
    go buf -- âîçâðàòèòü ðåçóëüòàò

-- |×èòàåì âñ¸, íå ïèøåì íè÷åãî, à CRC ñ÷èòàåòñÿ â äðóãîì ìåñòå ;)
eat_data callback = do
  allocaBytes aBUFFER_SIZE $ \buf -> do  -- èñïîëüçóåì `alloca`, ÷òîáû àâòîìàòè÷åñêè îñâîáîäèòü âûäåëåííûé áóôåð ïðè âûõîäå
    let go = do
          len <- callback "read" buf aBUFFER_SIZE
          if (len>0)
            then go
            else return len   -- Âîçâðàòèì 0, åñëè äàííûå êîí÷èëèñü, è îòðèöàòåëüíîå ÷èñëî, åñëè ïðîèçîøëà îøèáêà/áîëüøå äàííûõ íå íóæíî
    go  -- âîçâðàòèòü ðåçóëüòàò

impossible_to_decompress callback = do
  return CompressionLib.aFREEARC_ERRCODE_GENERAL   -- ñðàçó âîçâðàòèòü îøèáêó, ïîñêîëüêó ýòîò àëãîðèòì (FAKE/CRC_ONLY) íå ïîäëåæèò ðàñïàêîâêå

{-# NOINLINE copy_data                       #-}
{-# NOINLINE eat_data                        #-}


----------------------------------------------------------------------------------------------------
----- 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 configuredMethodSubsts str =
    str                       -- "3/$obj=2b/$iso=ecm+3b"
    .$ 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")]
    .$ filter (not.null.snd)  -- "-m$bmp=" îçíà÷àåò çàïðåòèòü èñïîëüçîâàíèå ñïåöèàëüíîãî àëãîðèòìà äëÿ ãðóïïû $bmp
    .$ mapSnds (subst2 list)  -- [("",["exe","lzma"]), ("$text",["ppmd"]), ("$obj",["lzma"]), ("$iso",["ecm","lzma"])]

    where list = prepareSubsts (concatMap reorder [configuredMethodSubsts, builtinMethodSubsts])   -- ñíà÷àëà ïîëüçîâàòåëüñêèå çàìåíû, çàòåì âñòðîåííûå, ÷òîáû äàòü ïåðâûì ïðèîðèòåò
          reorder list = a++b  where (a,b) = partition (notElem '#') list                          -- âíóòðè ýòèõ ãðóïï: ñíà÷àëà ñòðî÷êè, íå ñîäåðæàùèå #, çàòåì ñ # (ñíà÷àëà êîíêðåòíûå, çàòåì îáùèå çàìåíû)

-- Çàìåíà ïî ñïèñêó äëÿ ìåòîäà ñæàòèÿ (îáîáù¸ííîãî îáîçíà÷åíèÿ äëÿ ôàéëîâ âñåõ òèïîâ)
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  =  concatMap f . split_compressor
    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  / $exe=exe+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"
    , "3t  = dict:p: 64m:85% + lzp: 64m: 24:h20        :92% + grzip:m3:8m:l"
    , "4t  = dict:p: 64m:80% + lzp: 64m: 65:d1m:s16:h20:90% + ppmd:8:96m"
    , "5t  = dict:p: 64m:80% + lzp: 80m:105:d1m:s32:h22:92% + ppmd:12:192m"
    , "6t  = dict:p:128m:80% + lzp:160m:145:d1m:s32:h23:92% + ppmd:16:384m"
    , "7t  = dict:p:128m:80% + lzp:320m:185:d1m:s32:h24:92% + ppmd:18:512m"
    , "8t  = dict:p:128m:80% + lzp:320m:185:d1m:s32:h24:92% + ppmd:18:512m"
    , "9t  = dict:p:128m:80% + lzp:320m:185:d1m:s32:h24:92% + ppmd:18:512m"
    , ""
    , ";Binary files compression with slow and/or memory-expensive decompression"
    , "1b  = 1xb"
    , "#b  = #rep+#bx"
    , "2rep  = rep:  96m"
    , "3rep  = rep:  96m"
    , "4rep  = rep:  96m"
    , "5rep  = rep: 128m"
    , "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 = tor:3"
    , "2xb = tor:96m:h64m"
    , "#xb = delta + #binary"
    , ""
    , ";Binary files compression with fast decompression"
    , "1binary = tor:3"
    , "2binary = tor:  96m:h64m"
    , "3binary = lzma: 96m:h64m:fast  :mc8"
    , "4binary = lzma: 96m:h64m:normal:mc16"
    , "5binary = lzma: 16m:max"
    , "6binary = lzma: 32m:max"
    , "7binary = lzma: 64m:max"
    , "8binary = lzma:128m:max"
    , "9binary = lzma:255m:max"
    , ""
    , ";Synonyms"
    , "bcj = exe"
    , "#bx = #xb"
    , "#tx = #xt"
    , "x#  = #x"    -- ïðèíèìàåì îïöèè òèïà "-mx7" äëÿ ìèìèêðèè ïîä 7-zip
    , ""
    , ";Compression modes involving external PPMONSTR.EXE"
    , "#p  = #rep+exe+#xb / $obj=#pb / $text=#pt"
    , "5pt = dict:p: 64m:80% + lzp: 64m:32:h22:85% + pmm: 8:160m:r0"
    , "6pt = dict:p: 64m:80% + lzp: 64m:64:h22:85% + pmm:16:384m:r1"
    , "7pt = dict:p:128m:80% + lzp:128m:64:h23:85% + pmm:20:768m:r1"
    , "8pt = dict:p:128m:80% + lzp:128m:64:h23:85% + pmm:24:1536m:r1"
    , "9pt = dict:p:128m:80% + lzp:128m:64:h23:85% + pmm:25:2040m:r1"
    , "#pt = #t"
    , "#pb = #b"
    , ""
    , "#q  = #qb/#qt"
    , "5qt = dict:p:64m:80% + lzp:64m:64:d1m:24:h22:85% + pmm:10:160m:r1"
    , "5qb = rep: 128m      + delta                     + pmm:16:160m:r1"
    , "6qb = rep: 256m      + delta                     + pmm:20:384m:r1"
    , "7qb = rep: 512m      + delta                     + pmm:22:768m:r1"
    , "8qb = rep:1024m      + delta                     + pmm:24:1536m:r1"
    , "9qb = rep:2040m      + delta                     + pmm:25:2040m:r1"
    , "#qt = #pt"
    , "#qb = #pb"
    , ""
    , ";Sound wave files are compressed best with TTA"
    , "wav     = tta      ;best compression"
    , "wavfast = tta:m1   ;faster compression and decompression"
    , "1$wav  = wavfast"
    , "2$wav  = wavfast"
    , "#$wav  = wav"
    , "#x$wav = wavfast"
    , "#p$wav = wav"
    , ""
    , ";Bitmap graphic files are compressed best with GRZip"
    , "bmp        = mm    + grzip:m1:l:a  ;best compression"
    , "bmpfast    = mm    + grzip:m4:l:a  ;faster compression"
    , "bmpfastest = mm:d1 + tor:3:t0      ;fastest one"
    , "1$bmp  = bmpfastest"
    , "2$bmp  = bmpfastest"
    , "3$bmp  = bmpfast"
    , "#$bmp  = bmp"
    , "1x$bmp = bmpfastest"
    , "2x$bmp = bmpfastest"
    , "#x$bmp = mm+#binary"
    , "#p$bmp = bmp"
    , ""
    , ";Quick & dirty compression for data already compressed"
    , "4$compressed   = rep:96m + tor:c3"
    , "3$compressed   = rep:96m + tor:3"
    , "2$compressed   = rep:96m + tor:3"
    , "4x$compressed  = tor:8m:c3"
    , "3x$compressed  = rep:8m  + tor:3"
    , "2x$compressed  = rep:8m  + tor:3"
    ]

-- |Ìóëüòèìåäèéíûé òèï ôàéëîâ?
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

-- |Ðàçáèòü ìåòîä ñæàòèÿ íà çàãîëîâîê è îòäåëüíûå ïàðàìåòðû
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 #-}