blob: c9a7cfda8f9f588963afa0e87d3a7ec7c1dd8d60 (
plain)
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
|
module Messages.Progress where
import Common
import Messages
import Messages.Internal
import Utility.Metered
import Types
import Types.Messages
import Types.Key
import Data.Progress.Meter
import Data.Progress.Tracker
import Data.Quantity
{- Shows a progress meter while performing a transfer of a key.
- The action is passed a callback to use to update the meter. -}
metered :: Maybe MeterUpdate -> Key -> (MeterUpdate -> Annex a) -> Annex a
metered combinemeterupdate key a = go (keySize key)
where
go (Just size) = meteredBytes combinemeterupdate size a
go _ = a (const noop)
{- Shows a progress meter while performing an action on a given number
- of bytes. -}
meteredBytes :: Maybe MeterUpdate -> Integer -> (MeterUpdate -> Annex a) -> Annex a
meteredBytes combinemeterupdate size a = withOutputType go
where
go NormalOutput = do
progress <- liftIO $ newProgress "" size
meter <- liftIO $ newMeter progress "B" 25 (renderNums binaryOpts 1)
showOutput
r <- a $ \n -> liftIO $ do
setP progress $ fromBytesProcessed n
displayMeter stdout meter
maybe noop (\m -> m n) combinemeterupdate
liftIO $ clearMeter stdout meter
return r
go _ = a (const noop)
{- Progress dots. -}
showProgressDots :: Annex ()
showProgressDots = handleMessage q $
flushed $ putStr "."
{- Runs a command, the output of which is some sort of progress display.
-
- Normally, this is displayed to the user.
-
- In QuietOutput mode, both the stdout and stderr are discarded,
- unless the command fails, in which case stderr will be displayed.
-}
progressOutput :: FilePath -> [CommandParam] -> Annex Bool
progressOutput cmd ps = undefined
mkProgressHandler :: MeterUpdate -> Annex ProgressHandler
mkProgressHandler meter = ProgressHandler
<$> quietmode
<*> (stderrhandler <$> mkStderrEmitter)
<*> pure meter
where
quietmode = withOutputType $ \t -> return $ case t of
ProgressOutput -> True
_ -> False
stderrhandler emitter h = unlessM (hIsEOF h) $ do
void $ emitter =<< hGetLine h
stderrhandler emitter h
{- Generates an IO action that can be used to emit stderr.
-
- When a progress meter is displayed, this takes care to avoid
- messing it up with interleaved stderr from a command.
-}
mkStderrEmitter :: Annex (String -> IO ())
mkStderrEmitter = withOutputType go
where
go ProgressOutput = return $ \s -> hPutStrLn stderr ("E: " ++ s)
go _ = return (hPutStrLn stderr)
|
