forked from svn2github/freearc
-
Notifications
You must be signed in to change notification settings - Fork 1
/
Errors.hs
513 lines (417 loc) · 18.8 KB
/
Errors.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
{-# OPTIONS_GHC -cpp #-}
---------------------------------------------------------------------------------------------------
---- Ðåãèñòðàöèÿ îøèáîê/ïðåäóïðåæäåíèé è ïå÷àòü ñîîáùåíèé î íèõ. ----------------------------------
---------------------------------------------------------------------------------------------------
module Errors where
import Prelude hiding (catch)
import Control.Concurrent
import Control.Exception
import Control.Monad
import Data.Char
import Data.Maybe
import Data.IORef
import System.Exit
import System.IO
import System.IO.Unsafe
#if defined(FREEARC_WIN)
import GHC.ConsoleHandler
#else
import System.Posix.Signals
#endif
import CompressionLib (compressionLib_cleanup)
import Utils
import Files
import Charsets
-- |Êîäû âîçâðàòà ïðîãðàììû
aEXIT_CODE_SUCCESS = 0
aEXIT_CODE_WARNINGS = 1
aEXIT_CODE_FATAL_ERROR = 2
aEXIT_CODE_BAD_PASSWORD = 21
aEXIT_CODE_USER_BREAK = 255
-- |Âñå âîçìîæíûå òèïû îøèáîê è ïðåäóïðåæäåíèé
data ErrorTypes = GENERAL_ERROR [String]
| CMDLINE_GENERAL [String]
| CMDLINE_SYNTAX String
| CMDLINE_INCOMPATIBLE_OPTIONS String String
| CMDLINE_NO_COMMAND [String]
| CMDLINE_NO_ARCSPEC [String]
| CMDLINE_NO_FILENAMES [String]
| UNKNOWN_CMD String [String]
| CMDLINE_UNKNOWN_OPTION String
| CMDLINE_AMBIGUOUS_OPTION String [String]
| CMDLINE_BAD_OPTION_FORMAT String
| INVALID_OPTION_VALUE String String [String]
| CANT_READ_DIRECTORY String
| CANT_GET_FILEINFO String
| CANT_OPEN_FILE String
| BAD_CRC String
| BAD_CFG_SECTION String [String]
| OP_TERMINATED
| TERMINATED
| NOFILES
| SKIPPED_FAKE_FILES Int
| BROKEN_ARCHIVE FilePath [String]
| INTERNAL_ERROR String
| COMPRESSION_ERROR [String]
| BAD_PASSWORD FilePath FilePath
deriving (Eq)
--foreign import "&errCounter" :: Ptr Int
{-
data SqliteException = SqliteException Int String
deriving (Typeable)
catchSqlite :: IO a -> (SqliteException -> IO a) -> IO a
catchSqlite = catchDyn
throwSqlite :: SqliteException -> a
throwSqlite = throwDyn
-}
---------------------------------------------------------------------------------------------------
---- Îáðàáîòêà Ctrl-Break, Close è ò.ï. âíåøíèõ ñîáûòèé -------------------------------------------
---------------------------------------------------------------------------------------------------
setCtrlBreakHandler action = do
--myThread <- myThreadId
-- Ïðè âûõîäå èëè âîçíèêíîâåíèè èñêëþ÷åíèÿ âîññòàíîâèì ïðåäûäóùèé îáðàáîò÷èê ñîáûòèé
#if defined(FREEARC_WIN)
bracket (installHandler$ Catch onBreak) (installHandler) $ \oldHandler -> do
action
#else
let catchSignals a = installHandler sigINT (CatchOnce$ onBreak undefined) Nothing
bracket (catchSignals (CatchOnce$ onBreak (error "onBreak"))) (catchSignals) $ \oldHandler -> do
action
#endif
-- |Âûçâàòü fail, åñëè óñòàíîâëåí ôëàã àâàðèéíîãî çàâåðøåíèÿ ïðîãðàììû
failOnTerminated = do
whenM (val operationTerminated) $ do
fail ""
-- |Îáðàáîòêà Ctrl-Break è íàæàòèÿ íà Cancel ñâîäèòñÿ ê âûïîëíåíèþ ôèíàëèçàòîðîâ è
-- óñòàíîâêå ñïåö. ôëàãà, êîòîðûé ïðîâåðÿåòñÿ êîëëáýêàìè, âûçûâàåìûìè èç Ñè
onBreak event = terminateOperation
terminateOperation = do
isFM <- val fileManagerMode
registerError$ iif isFM OP_TERMINATED TERMINATED
-- |Ïðèíóäèòåëüíî çàâåðøàåò âûïîëíåíèå ïðîãðàììû ñ çàäàííûì exitCode è ïå÷àòüþ ñîîáùåíèÿ msg
shutdown msg exitCode = do
w <- val warnings
-- Make cleanup unless this is a second call (after pause)
unlessM (val programFinished) $ do
programFinished =: True
separator' =: ("","\n")
log_separator' =: "\n"
fin <- val finalizers
for fin $ \(name,id,action) -> do
ignoreErrors$ action
compressionLib_cleanup
unlessM (val fileManagerMode) $ do
case w of
0 -> when (exitCode==aEXIT_CODE_SUCCESS) $ condPrintLineLn "k" "All OK"
_ -> condPrintLineLn "n"$ "There were "++show w++" warning(s)"
ignoreErrors (msg &&& condPrintLineLn "n" msg)
condPrintLineLn "e" ""
#if !defined(FREEARC_WIN) && !defined(FREEARC_GUI)
putStrLn "" -- â Unix îòñóòñòâóåò àâòîìàòè÷åñêèé ïåðåâîä ñòðîêè â òåðìèíàëå ïî çàâåðøåíèþ ïðîãðàììû
#endif
ignoreErrors$ closeLogFile
ignoreErrors$ hFlush stdout
ignoreErrors$ hFlush stderr
--killThread myThread
-- Make a pause if necessary
when (exitCode/=aEXIT_CODE_USER_BREAK) $ do
warningsBefore' <- val warningsBefore
pause_option <- val pause_before_exit
pause <- val pauseAction
pause `on` case pause_option of
"on" -> True
"off" -> False
"on-warnings" -> w>warningsBefore' || exitCode/=aEXIT_CODE_SUCCESS
"on-error" -> exitCode/=aEXIT_CODE_SUCCESS
_ -> False
-- And finally - exit program!
exit (exitCode ||| (w &&& aEXIT_CODE_WARNINGS))
#if 0
-- Áîëåå êîððåêòíûé ñïîñîá çàâåðøåíèÿ ïðîãðàììû, ê ñîæàëåíèþ arc.exe ñ íèì èíîãäà âèñíåò
exitWith$ case () of
_ | exitCode>0 -> ExitFailure exitCode
| w>0 -> ExitFailure aEXIT_CODE_WARNINGS
| otherwise -> ExitSuccess
#endif
return undefined
-- |"handle" ñ âûïîëíåíèåì "onException" òàêæå ïðè ^Break
handleCtrlBreak name onException action = do
failOnTerminated
id <- newId
handle (\e -> do onException; throwIO e) $ do
bracket_ (addFinalizer name id onException)
(removeFinalizer id)
(action)
-- |"bracket" ñ âûïîëíåíèåì "close" òàêæå ïðè ^Break
bracketCtrlBreak name init close action = do
failOnTerminated
id <- newId
bracket (do x<-init; addFinalizer name id (close x); return x)
(\x -> do removeFinalizer id; close x)
action
-- |bracketCtrlBreak, âûïîëíÿþùèé fail ïðè âîçâðàòå Nothing èç init
bracketCtrlBreakMaybe name init fail close action = do
bracketCtrlBreak name (do x<-init; when (isNothing x) fail; return x)
(`whenJust_` close)
(`whenJust` action)
-- |Âûïîëíèòü close-äåéñòâèå ïî çàâåðøåíèþ action
ensureCtrlBreak name close action = bracketCtrlBreak name (return ()) (\_->close) (\_->action)
-- Äîáàâèòü/óäàëèòü finalizer â ñïèñîê
addFinalizer name id action = finalizers .= ((name,id,action):)
removeFinalizer id = finalizers .= filter ((/=id).snd3)
newId = do curId+=1; id<-val curId; return id
-- |Óíèêàëüíûé íîìåð
curId :: IORef Int
curId = unsafePerformIO (ref 0)
{-# NOINLINE curId #-}
-- |Ñïèñîê äåéñòâèé, êîòîðûå íàäî âûïîëíèòü ïåðåä àâàðèéíûì çàâåðøåíèåì ïðîãðàììû
finalizers :: IORef [(String, Int, IO ())]
finalizers = unsafePerformIO (ref [])
{-# NOINLINE finalizers #-}
-- |ÈÄ îñíîâíîãî òðåäà îïåðàöèè (òîëüêî â ðåæèìå ôàéë-ìåíåäæåðà)
parent_id :: IORef ThreadId
parent_id = unsafePerformIO (ref undefined)
{-# NOINLINE parent_id #-}
-- |Ôëàã, ïîêàçûâàþùèé ÷òî ìû íàõîäèìñÿ â ðåæèìå ïðåðûâàíèÿ òåêóùåé îïåðàöèè
operationTerminated = unsafePerformIO (ref False)
{-# NOINLINE operationTerminated #-}
-- |Óñòàíàâëèâàåòñÿ ïîñëå çàâåðøåíèÿ âûïîëíåíèÿ âñåõ êîìàíä, êîãäà ìû ïðîñòî æä¸ì çàêðûòèÿ îêíà ïðîãðàììû
programFinished = unsafePerformIO (ref False)
{-# NOINLINE programFinished #-}
-- |Ðåæèì ðàáîòû ôàéë-ìåíåäæåðà: ïðè ýòîì registerError îáðàáàòûâàåòñÿ ïî-äðóãîìó - ìû äîæèäàåìñÿ çàâåðøåíèÿ âñåõ òðåäîâ óïàêîâêè è ðàñïàêîâêè
fileManagerMode = unsafePerformIO (ref False)
{-# NOINLINE fileManagerMode #-}
-- |Äåëàòü ëè ïàóçó ïåðåä âûõîäîì èç ïðîãðàììû?
pause_before_exit = unsafePerformIO (ref "")
{-# NOINLINE pause_before_exit #-}
-- |UI-îïåðàöèÿ, âûçûâàåìàÿ äëÿ çàäåðæêè âûõîäà èç ïðîãðàììû
pauseAction = unsafePerformIO (ref$ return ()) :: IORef (IO())
{-# NOINLINE pauseAction #-}
---------------------------------------------------------------------------------------------------
---- Òåêñòû ñîîáùåíèé î ðàçëè÷íûõ òèïàõ îøèáîê. Ïîäõîäÿùèé ðåñóðñ äëÿ èíòåðíàëèçàöèè --------------
---------------------------------------------------------------------------------------------------
errormsg (GENERAL_ERROR msgs) =
i18fmt msgs
errormsg (BROKEN_ARCHIVE arcname msgs) = do
msg <- i18fmt msgs
i18fmt ["0341 %1 isn't archive or this archive is corrupt: %2. Please recover it using 'r' command or use -tp- option to ignore Recovery Record", arcname, msg]
errormsg (INTERNAL_ERROR msg) =
return$ "FreeArc internal error: "++msg
errormsg (COMPRESSION_ERROR msgs) =
i18fmt msgs
errormsg (CMDLINE_GENERAL msgs) =
i18fmt msgs
errormsg (CMDLINE_SYNTAX syntax) =
i18fmt ["0318 command syntax is \"%1\"", syntax]
errormsg (CMDLINE_INCOMPATIBLE_OPTIONS option1 option2) =
i18fmt ["0319 options %1 and %2 can't be used together", option1, option2]
errormsg (UNKNOWN_CMD cmd known_cmds) =
i18fmt ["0320 unknown command \"%1\". Supported commands are: %2", cmd, joinWith ", " known_cmds]
errormsg (CMDLINE_UNKNOWN_OPTION option) =
i18fmt ["0321 unknown option \"%1\"", option]
errormsg (CMDLINE_AMBIGUOUS_OPTION option variants) = do
or <- i18n"0323 or"
i18fmt ["0322 ambiguous option \"%1\" - is that %2?", option, enumerate or variants]
errormsg (CMDLINE_BAD_OPTION_FORMAT option) =
i18fmt ["0325 option \"%1\" have illegal format", option]
errormsg (INVALID_OPTION_VALUE fullname shortname valid_values) = do
or <- i18n"0323 or"
let spelling | shortname>"" = (('-':shortname)++)
| otherwise = (("--"++fullname++"=")++)
i18fmt ["0326 %1 option must be one of: %2", fullname, enumerate or (map spelling valid_values)]
errormsg (CMDLINE_NO_COMMAND args) =
i18fmt ["0327 no command name in command: %1", unwords args]
errormsg (CMDLINE_NO_ARCSPEC args) =
i18fmt ["0328 no archive name in command: %1", unwords args]
errormsg (CMDLINE_NO_FILENAMES args) =
i18fmt ["0329 no filenames in command: %1", unwords args]
errormsg (CANT_READ_DIRECTORY dir) =
i18fmt ["0330 can't read directory \"%1\"", dir]
errormsg (CANT_GET_FILEINFO filename) =
i18fmt ["0331 can't get info about file \"%1\"", filename]
errormsg (CANT_OPEN_FILE filename) =
i18fmt ["0332 can't open file \"%1\"", filename]
errormsg (BAD_CRC filename) =
i18fmt ["0333 CRC error in file \"%1\"", filename]
errormsg (BAD_CFG_SECTION cfgfile section) =
i18fmt ["0334 bad section %1 in %2", head section, cfgfile]
errormsg (OP_TERMINATED) =
i18fmt ["0455 Operation terminated by user!"]
errormsg (TERMINATED) =
i18fmt ["0456 Program terminated by user!"]
errormsg (NOFILES) =
i18fmt ["0337 no files, erasing empty archive"]
errormsg (SKIPPED_FAKE_FILES n) =
i18fmt ["0338 skipped %1 fake files", show n]
errormsg (BAD_PASSWORD archive "") =
i18fmt ["0339 bad password for archive %1", archive]
errormsg (BAD_PASSWORD archive file) =
i18fmt ["0340 bad password for %1 in archive %2", file, archive]
-- |Ïåðå÷èñëèòü ñïèñîê çíà÷åíèé
enumerate s list = joinWith2 ", " (" "++s++" ") (map quote list)
{-# NOINLINE errormsg #-}
----------------------------------------------------------------------------------------------------
---- Êîäû âûõîäà äëÿ ðàçëè÷íûõ îøèáîê --------------------------------------------------------------
----------------------------------------------------------------------------------------------------
errcode TERMINATED = aEXIT_CODE_USER_BREAK
errcode BAD_PASSWORD{} = aEXIT_CODE_BAD_PASSWORD
errcode _ = aEXIT_CODE_FATAL_ERROR
----------------------------------------------------------------------------------------------------
---- Ââîä/âûâîä íà ýêðàí â êîäèðîâêå, çàäàííîé îïöèåé -sct -----------------------------------------
----------------------------------------------------------------------------------------------------
#ifdef FREEARC_GUI
myPutStr = doNothing
myPutStrLn = doNothing
myFlushStdout = doNothing0
#else
myGetLine = getLine >>= terminal2str
myPutStr = putStr =<<. str2terminal
myPutStrLn = putStrLn =<<. str2terminal
myFlushStdout = hFlush stdout
#endif
----------------------------------------------------------------------------------------------------
---- Ðàáîòà ñ ëîãôàéëîì è óïðàâëåíèå îáú¸ìîì âûâîäà íà ýêðàí â ñîîòâåòñòâèè ñ îïöèåé --display -----
----------------------------------------------------------------------------------------------------
-- Íàïå÷àòàòü çàäàííóþ ñòðîêó, îòäåëèâ å¸ ïðè íåîáõîäèìîñòè îò ïðåäûäóùåé êîìàíäû/îáðàáîòàííîãî àðõèâà
-- Êðîìå òîãî, ïåðâàÿ áóêâà ïå÷àòàåìîé ñòðîêè ïåðåâîäèòñÿ â íèæíèé ðåãèñòð,
-- åñëè îíà ïå÷àòàåòñÿ íåïîñðåäñòâåííî ïîñëå çàãîëîâêà ïðîãðàììû
printLine = printLineC ""
printLineC c str = do
(oldc,separator) <- val separator'
let makeLower (x:y:zs) | isLower y = toLower x:y:zs
makeLower xs = xs
let handle "w" = stderr
handle _ = stdout
#ifndef FREEARC_GUI
hPutStr (handle oldc) =<< str2terminal separator
hPutStr (handle c) =<< str2terminal ((oldc=="h" &&& makeLower) str)
hFlush (handle c)
#endif
separator' =: (c,"")
-- |Íàïå÷àòàòü ñòðîêó ñ ðàçäåëèòåëåì ñòðîê ïîñëå íå¸
printLineLn str = do
printLine str
printLineNeedSeparator "\n"
-- Îòäåëèòü ïîñëåäóþùèé âûâîä çàäàííîé ñòðîêîé. Íå âûâîäèì ýòó ñòðîêó ñðàçó,
-- ïîñêîëüêó íèêàêîãî ïîñëåäóþùåãî âûâîäà ìîæåò è íå áûòü :)))
printLineNeedSeparator str = do
separator' =: ("",str)
-- Çàïèñàòü ñòðîêó â ëîãôàéë.
-- Âûâåñòè å¸ íà ýêðàí ïðè óñëîâèè, ÷òî å¸ âûâîä íå çàïðåù¸í îïöèåé --display
condPrintLine c line = do
if c=="G" then val loggingHandlers >>= mapM_ ($line) else do
display_option <- val display_option'
when (c/="$" || (display_option `contains` '#')) $ do
printLog line
when (display_option `contains_one_of` c) $ do
printLineC c line
-- |Íàïå÷àòàòü ñòðîêó ñ ðàçäåëèòåëåì ñòðîê ïîñëå íå¸
condPrintLineLn c line = do
condPrintLine c line
condPrintLineNeedSeparator c "\n"
-- Îòäåëèòü ïîñëåäóþùèé âûâîä çàäàííîé ñòðîêîé ïðè óñëîâèè ðàçðåøåíèÿ âûâîäà êëàññà c
condPrintLineNeedSeparator c str = do
display_option <- val display_option'
when (c/="$" || (display_option `contains` '#')) $ do
log_separator' =: str
when (c=="" || (display_option `contains_one_of` c)) $ do
separator' =: (c,str)
-- Îòêðûòü ëîãôàéë
openLogFile logfilename = do
closeLogFile -- çàêðûòü ïðåäûäóùèé, åñëè áûë
logfile <- case logfilename of
"" -> return Nothing
log -> fileAppendText log >>== Just
logfile' =: logfile
-- Âûâåñòè ñòðîêó â ëîãôàéë
printLog line = do
separator <- val log_separator'
whenJustM_ (val logfile') $ \log -> do
fileWrite log =<< str2logfile (separator ++ line); fileFlush log
log_separator' =: ""
-- Çàêðûòü ëîãôàéë
closeLogFile = do
whenJustM_ (val logfile') fileClose
logfile' =: Nothing
-- Ïåðåìåííàÿ, õðàíÿùàÿ Handle ëîãôàéëà
logfile' = unsafePerformIO$ newIORef Nothing
-- Ïåðåìåííûå, èñïîëüçóåìûå äëÿ óêðàøåíèÿ ïå÷àòè
separator' = unsafePerformIO$ newIORef ("","") :: IORef (String,String)
log_separator' = unsafePerformIO$ newIORef "\n" :: IORef String
display_option' = unsafePerformIO$ newIORef$ error "undefined display_option"
-- Îïåðàöèè âûâîäà ñîîáùåíèé â ëîã
loggingHandlers = unsafePerformIO$ newIORef [] :: IORef [String -> IO ()]
{-# NOINLINE printLine #-}
{-# NOINLINE printLineNeedSeparator #-}
{-# NOINLINE condPrintLine #-}
{-# NOINLINE condPrintLineNeedSeparator #-}
{-# NOINLINE separator' #-}
{-# NOINLINE log_separator' #-}
{-# NOINLINE display_option' #-}
----------------------------------------------------------------------------------------------------
---- Ïå÷àòü ñîîáùåíèé îá îøèáêàõ è ïðåäóïðåæäåíèé
----------------------------------------------------------------------------------------------------
-- |Çàïèñü ñîîáùåíèÿ îá îøèáêå â ëîãôàéë è àâàðèéíîå çàâåðøåíèå ïðîãðàììû ñ ýòèì ñîîáùåíèåì
registerError err = do
msg <- errormsg err
msg <- if err `elem` [TERMINATED,OP_TERMINATED]
then return msg
else i18fmt ["0316 ERROR: %1", msg]
val errorHandlers >>= mapM_ ($msg)
-- Åñëè ìû íå â ðåæèìå ôàéë-ìåíåäæåðà - ñîâåðøàåì àâàðèéíûé âûõîä èç ïðîãðàììû
unlessM (val fileManagerMode) $ do
shutdown msg (errcode err)
-- Èíà÷å æä¸ì çàâåðøåíèÿ âñåõ òðåäîâ êîìïðåññèè
operationTerminated =: True
killThread =<< val parent_id
fail ""
-- |Çàïèñü ïðåäóïðåæäåíèÿ â ëîãôàéë è âûâîä åãî íà ýêðàí
registerWarning warn = do
warnings += 1
msg <- errormsg warn
msg <- i18fmt ["0317 WARNING: %1", msg]
val warningHandlers >>= mapM_ ($msg)
condPrintLineLn "w" msg
-- |Âûïîëíèòü îïåðàöèþ è âîçâðàòèòü êîëè÷åñòâî âîçíèêøèõ ïðè ýòîì warning'îâ
count_warnings action = do
w0 <- val warnings
action
w <- val warnings
return (w-w0)
-- |Ñ÷¸ò÷èê îøèáîê, âîçíèêøèõ â õîäå ðàáîòû ïðîãðàììû
warnings = unsafePerformIO$ newIORef 0 :: IORef Int
-- |Êîëè÷åñòâî ïðåäóïðåæäåíèé ïåðåä ïîñëåäíèì ïîêàçîì äèàëîãà ïðîãðåññà
warningsBefore = unsafePerformIO$ newIORef 0 :: IORef Int
-- Â çàâèñèìîñòè îò ðåæèìà çàðåãèñòðèðîâàòü îøèáêó èëè ïðåäóïðåæäåíèå
registerThreadError err = do
isFM <- val fileManagerMode
(iif isFM registerWarning registerError) err
-- Îïåðàöèè, âûïîëíÿåìûå ïðè ïîÿâëåíèè îøèáêè/ïðåäóïðåæäåíèÿ (ðåãèñòðèðóþòñÿ â äðóãèõ ÷àñòÿõ ïðîãðàììû)
errorHandlers = unsafePerformIO$ newIORef [] :: IORef [String -> IO ()]
warningHandlers = unsafePerformIO$ newIORef [] :: IORef [String -> IO ()]
{-# NOINLINE registerError #-}
{-# NOINLINE registerWarning #-}
{-# NOINLINE warnings #-}
{-# NOINLINE warningsBefore #-}
{-# NOINLINE errorHandlers #-}
{-# NOINLINE warningHandlers #-}
----------------------------------------------------------------------------------------------------
---- Ðàáîòà ñ ôàéëàìè
----------------------------------------------------------------------------------------------------
-- |Âîçâðàòèòü Nothing è íàïå÷àòàòü ñîîáùåíèå îá îøèáêå, åñëè ôàéë íå óäàëîñü îòêðûòü
tryOpen filename = catchJust ioErrors
(fileOpen filename >>== Just)
(\e -> do registerWarning$ CANT_OPEN_FILE filename; return Nothing)
-- |Ñêîïèðîâàòü ôàéë
fileCopy srcname dstname = do
bracketCtrlBreak "fileClose1:fileCopy" (fileOpen srcname) (fileClose) $ \srcfile -> do
handleCtrlBreak "fileRemove1:fileCopy" (ignoreErrors$ fileRemove dstname) $ do
bracketCtrlBreak "fileClose2:fileCopy" (fileCreate dstname) (fileClose) $ \dstfile -> do
size <- fileGetSize srcfile
fileCopyBytes srcfile size dstfile
----------------------------------------------------------------------------------------------------
----- External functions ---------------------------------------------------------------------------
----------------------------------------------------------------------------------------------------
-- |Stop program execution
foreign import ccall unsafe "stdlib.h exit"
exit :: Int -> IO ()