github/semantic
1
1
Fork 0
mirror of https://github.com/github/semantic.git synced 2024-12-20 21:31:48 +03:00
Code Issues Projects Releases Wiki Activity

Add an option controlling the log level.

Browse Source
This commit is contained in:
Rob Rix 2017-07-21 16:04:35 -04:00
parent 94e8eb7f20
commit 9937a419d1
2 changed files with 6 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
src/Semantic/Task.hs
View File

@ -142,11 +142,13 @@ distributeFoldMap toTask inputs = fmap fold (distribute (fmap toTask inputs))
-- | Options controlling 'Task' logging, error handling, &c.
data Options = Options
{ optionsColour :: Maybe Bool -- ^ Whether to use colour formatting for errors. 'Nothing' implies automatic selection for the stderr handle, using colour for terminal handles but not for regular files.
, optionsLevel :: Maybe Level -- ^ What level of messages to log. 'Nothing' disabled logging.
}
defaultOptions :: Options
defaultOptions = Options
{ optionsColour = Nothing
, optionsLevel = Just Warning
}
configureOptionsForHandle :: Handle -> Options -> IO Options
@ -173,7 +175,9 @@ runTaskWithOptions options task = do
ReadBlobs source -> pure <$ writeLog Info "ReadBlobs" <*> either Files.readBlobsFromHandle (traverse (uncurry Files.readFile)) source
ReadBlobPairs source -> pure <$ writeLog Info "ReadBlobPairs" <*> either Files.readBlobPairsFromHandle (traverse (traverse (uncurry Files.readFile))) source
WriteToOutput destination contents -> pure <$ writeLog Info "WriteToOutput" <*> liftIO (either B.hPutStr B.writeFile destination contents)
WriteLog level message -> pure <$> liftIO (atomically (writeTMQueue logQueue (level, message)))
WriteLog level message
| Just logLevel <- optionsLevel options, level <= logLevel -> pure <$> liftIO (atomically (writeTMQueue logQueue (level, message)))
| otherwise -> pure (pure ())
Parse parser blob -> pure <$ writeLog Info "Parse" <*> runParser options parser blob
Decorate algebra term -> pure <$ writeLog Info "Decorate" <*> pure (decoratorWithAlgebra algebra term)
Diff differ terms -> pure <$ writeLog Info "Diff" <*> pure (differ terms)

1
src/SemanticCmdLine.hs
View File

@ -41,6 +41,7 @@ arguments = info (version <*> helper <*> ((,) <$> optionsParser <*> argumentsPar
optionsParser = Task.Options
<$> options [("yes", Just True), ("no", Just False), ("auto", Nothing)] (long "colour" <> long "color" <> value Nothing <> help "Enable (yes)/disable (no) colour output, or enable automatically iff stderr is a terminal device.")
<*> pure (Just Task.Warning)
argumentsParser = (. Task.writeToOutput) . (>>=)
<$> hsubparser (diffCommand <> parseCommand)
<*> ( Right <$> strOption (long "output" <> short 'o' <> help "Output path, defaults to stdout")