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
|
{- git-annex Messages data types
-
- Copyright 2012-2020 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Types.Messages where
import qualified Utility.Aeson as Aeson
import Utility.Metered
import Control.Concurrent
import System.Console.Regions (ConsoleRegion)
import qualified Data.ByteString as S
import qualified Data.ByteString.Lazy as L
data OutputType
= NormalOutput
| QuietOutput
| JSONOutput JSONOptions
| SerializedOutput
(SerializedOutput -> IO ())
(IO (Maybe SerializedOutputResponse))
data JSONOptions = JSONOptions
{ jsonProgress :: Bool
, jsonErrorMessages :: Bool
}
deriving (Show)
adjustOutputType :: OutputType -> OutputType -> OutputType
adjustOutputType (JSONOutput old) (JSONOutput new) = JSONOutput $ JSONOptions
{ jsonProgress = jsonProgress old || jsonProgress new
, jsonErrorMessages = jsonErrorMessages old || jsonErrorMessages new
}
adjustOutputType _old new = new
data SideActionBlock = NoBlock | StartBlock | InBlock
deriving (Eq)
data MessageState = MessageState
{ outputType :: OutputType
, concurrentOutputEnabled :: Bool
, sideActionBlock :: SideActionBlock
, consoleRegion :: Maybe ConsoleRegion
, consoleRegionErrFlag :: Bool
, jsonBuffer :: Maybe Aeson.Object
, promptLock :: MVar () -- left full when not prompting
, clearProgressMeter :: IO ()
}
newMessageState :: IO MessageState
newMessageState = do
promptlock <- newMVar ()
return $ MessageState
{ outputType = NormalOutput
, concurrentOutputEnabled = False
, sideActionBlock = NoBlock
, consoleRegion = Nothing
, consoleRegionErrFlag = False
, jsonBuffer = Nothing
, promptLock = promptlock
, clearProgressMeter = return ()
}
-- | When communicating with a child process over a pipe while it is
-- performing some action, this is used to pass back output that the child
-- would normally display to the console.
data SerializedOutput
= OutputMessage S.ByteString
| OutputError String
| BeginProgressMeter
| UpdateProgressMeterTotalSize TotalSize
| UpdateProgressMeter BytesProcessed
| EndProgressMeter
| BeginPrompt
| EndPrompt
| JSONObject L.ByteString
-- ^ This is always sent, it's up to the consumer to decide if it
-- wants to display JSON, or human-readable messages.
deriving (Show)
data SerializedOutputResponse
= ReadyPrompt
deriving (Eq, Show)
-- | Message identifiers. Avoid changing these.
data MessageId
= FileNotFound
| FileBeyondSymbolicLink
deriving (Show)
|
