be36e208c2
When a nonexistant file is passed to a command and --json-error-messages is enabled, output a JSON object indicating the problem. (But git ls-files --error-unmatch still displays errors about such files in some situations.) I don't like the duplication of the name of the command introduced by this, but I can't see a great way around it. One way would be to pass the Command instead. When json is not enabled, the stderr is unchanged. This is necessary because some commands like find have custom output. So dislaying "find foo not found" would be wrong. So had to complicate things with toplevelFileProblem having different output with and without json. When not using --json-error-messages but still using --json, it displays the error to stderr, but does display a json object without the error. It does have an errorid though. Unsure how useful that behavior is. Sponsored-by: Dartmouth College's Datalad project
92 lines
2.4 KiB
Haskell
92 lines
2.4 KiB
Haskell
{- 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)
|
|
|
|
-- | Error identifiers. Avoid changing these.
|
|
data ErrorId
|
|
= FileNotFound
|
|
| FileBeyondSymbolicLink
|
|
deriving (Show)
|