diff options
Diffstat (limited to 'Messages.hs')
-rw-r--r-- | Messages.hs | 42 |
1 files changed, 26 insertions, 16 deletions
diff --git a/Messages.hs b/Messages.hs index d7eabccbb..57b706804 100644 --- a/Messages.hs +++ b/Messages.hs @@ -1,6 +1,6 @@ {- git-annex output messages - - - Copyright 2010 Joey Hess <joey@kitenet.net> + - Copyright 2010-2011 Joey Hess <joey@kitenet.net> - - Licensed under the GNU GPL version 3 or higher. -} @@ -20,7 +20,9 @@ module Messages ( warning, indent, maybeShowJSON, - showWith, + showCustom, + showHeader, + showRaw, setupConsole ) where @@ -88,6 +90,28 @@ warning' w = do indent :: String -> String indent s = join "\n" $ map (\l -> " " ++ l) $ lines s +{- Shows a JSON value only when in json mode. -} +maybeShowJSON :: JSON a => [(String, a)] -> Annex () +maybeShowJSON v = handle (JSON.add v) q + +{- Performs an action that outputs nonstandard/customized output, and + - in JSON mode wraps its output in JSON.start and JSON.end, so it's + - a complete JSON document. + - This is only needed when showStart and showEndOk is not used. -} +showCustom :: String -> Annex Bool -> Annex () +showCustom command a = do + handle (JSON.start command Nothing) q + r <- a + handle (JSON.end r) q + +showHeader :: String -> Annex () +showHeader h = handle q $ do + putStr $ h ++ ": " + hFlush stdout + +showRaw :: String -> Annex () +showRaw s = handle q $ putStrLn s + {- By default, haskell honors the user's locale in its output to stdout - and stderr. While that's great for proper unicode support, for git-annex - all that's really needed is the ability to display simple messages @@ -109,20 +133,6 @@ handle json normal = do Annex.QuietOutput -> q Annex.JSONOutput -> liftIO json -{- Shows a JSON value only when in json mode. -} -maybeShowJSON :: JSON a => [(String, a)] -> Annex () -maybeShowJSON v = handle (JSON.add v) q - -{- Performs an a action (such as displaying something) only when - - not in json mode, and not quiet. -} -showWith :: Annex () -> Annex () -showWith a = do - output <- Annex.getState Annex.output - case output of - Annex.NormalOutput -> a - Annex.QuietOutput -> q - Annex.JSONOutput -> q - q :: Monad m => m () q = return () |