70bc30acb1
Oh joyous day, this is probably git-annex's oldest implementation wart, source of much unncessary bother. Now that we have a StartMessage, showEndResult' can look at it to know if it needs to display an end message or not. This is also going to be faster, because it avoids an uncessary state lookup for each file processed.
55 lines
1.4 KiB
Haskell
55 lines
1.4 KiB
Haskell
{- git-annex Messages data types
|
|
-
|
|
- Copyright 2012-2018 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 Control.Concurrent
|
|
import System.Console.Regions (ConsoleRegion)
|
|
|
|
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
|
|
, consoleRegion :: Maybe ConsoleRegion
|
|
, consoleRegionErrFlag :: Bool
|
|
, 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
|
|
, consoleRegion = Nothing
|
|
, consoleRegionErrFlag = False
|
|
, jsonBuffer = Nothing
|
|
, promptLock = promptlock
|
|
}
|