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
|
{- git-annex Messages data types
-
- Copyright 2012-2018 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# LANGUAGE CPP #-}
module Types.Messages where
import qualified Data.Aeson as Aeson
import Control.Concurrent
#ifdef WITH_CONCURRENTOUTPUT
import System.Console.Regions (ConsoleRegion)
#endif
data OutputType = NormalOutput | QuietOutput | JSONOutput JSONOptions
deriving (Show)
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
, implicitMessages :: Bool
#ifdef WITH_CONCURRENTOUTPUT
, consoleRegion :: Maybe ConsoleRegion
, consoleRegionErrFlag :: Bool
#endif
, jsonBuffer :: Maybe Aeson.Object
, promptLock :: MVar () -- left full when not prompting
}
newMessageState :: IO MessageState
newMessageState = do
promptlock <- newMVar ()
return $ MessageState
{ outputType = NormalOutput
, concurrentOutputEnabled = False
, sideActionBlock = NoBlock
, implicitMessages = True
#ifdef WITH_CONCURRENTOUTPUT
, consoleRegion = Nothing
, consoleRegionErrFlag = False
#endif
, jsonBuffer = Nothing
, promptLock = promptlock
}
|
