diff --git a/rio-prettyprint.cabal b/rio-prettyprint.cabal --- a/rio-prettyprint.cabal +++ b/rio-prettyprint.cabal @@ -1,17 +1,18 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.1. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- --- hash: 1d949118732b2fc99142bfdd103496c89c364dd299c30d2039eac2acea3de22b +-- hash: bf50273f06f81eee478b5dd1dc56a8006c9fd634dc6eb2a70fd70821b5a1cade name: rio-prettyprint -version: 0.1.0.0 +version: 0.1.1.0 synopsis: Pretty-printing for RIO +description: Combine RIO's log capabilities with pretty printing category: Development -homepage: https://github.com/commercialhaskell/stack#readme -bug-reports: https://github.com/commercialhaskell/stack/issues +homepage: https://github.com/commercialhaskell/rio-prettyprint#readme +bug-reports: https://github.com/commercialhaskell/rio-prettyprint/issues author: Michael Snoyman maintainer: michael@snoyman.com copyright: 2018-2019 FP Complete @@ -21,7 +22,7 @@ source-repository head type: git - location: https://github.com/commercialhaskell/stack + location: https://github.com/commercialhaskell/rio-prettyprint library exposed-modules: @@ -38,7 +39,7 @@ Cabal , aeson , annotated-wl-pprint - , ansi-terminal + , ansi-terminal >=0.9 , array , base >=4.10 && <5 , colour diff --git a/src/RIO/PrettyPrint.hs b/src/RIO/PrettyPrint.hs --- a/src/RIO/PrettyPrint.hs +++ b/src/RIO/PrettyPrint.hs @@ -18,6 +18,7 @@ -- to provide consistency. , style , displayMilliseconds + , logLevelToStyle -- * Formatting utils , bulletedList , spacedBulletedList @@ -174,3 +175,14 @@ -- each. spacedBulletedList :: [StyleDoc] -> StyleDoc spacedBulletedList = mconcat . intersperse (line <> line) . map (("*" <+>) . align) + +-- | The 'Style' intended to be associated with a 'LogLevel'. +-- +-- @since 0.1.1.0 +logLevelToStyle :: LogLevel -> Style +logLevelToStyle level = case level of + LevelDebug -> Debug + LevelInfo -> Info + LevelWarn -> Warning + LevelError -> Error + LevelOther _ -> OtherLevel diff --git a/src/RIO/PrettyPrint/DefaultStyles.hs b/src/RIO/PrettyPrint/DefaultStyles.hs --- a/src/RIO/PrettyPrint/DefaultStyles.hs +++ b/src/RIO/PrettyPrint/DefaultStyles.hs @@ -17,6 +17,9 @@ defaultStyles = array (minBound, maxBound) [ (Error, ("error", [SetColor Foreground Vivid Red])) , (Warning, ("warning", [SetColor Foreground Dull Yellow])) + , (Info, ("info", [SetColor Foreground Dull Blue])) + , (Debug, ("debug", [SetColor Foreground Dull Green])) + , (OtherLevel, ("other-level", [SetColor Foreground Dull Magenta])) , (Good, ("good", [SetColor Foreground Vivid Green])) , (Shell, ("shell", [SetColor Foreground Vivid Magenta])) , (File, ("file", [SetColor Foreground Dull Cyan])) @@ -30,4 +33,7 @@ , (Target, ("target", [SetColor Foreground Vivid Cyan])) -- TODO: what color should Module be? , (Module, ("module", [SetColor Foreground Vivid Magenta])) - , (PkgComponent, ("package-component", [SetColor Foreground Vivid Cyan])) ] + , (PkgComponent, ("package-component", [SetColor Foreground Vivid Cyan])) + , (Secondary, ("secondary", [SetColor Foreground Vivid Black])) + , (Highlight, ("highlight", [SetColor Foreground Vivid Green])) + ] diff --git a/src/RIO/PrettyPrint/Types.hs b/src/RIO/PrettyPrint/Types.hs --- a/src/RIO/PrettyPrint/Types.hs +++ b/src/RIO/PrettyPrint/Types.hs @@ -20,27 +20,42 @@ -- |A style of rio-prettyprint's output. data Style - = Error -- Should be used sparingly, not to style entire long messages. For - -- example, it's used to style the "Error:" label for an error - -- message, not the entire message. - | Warning -- Should be used sparingly, not to style entire long messages. For - -- example, it's used to style the "Warning:" label for an error - -- message, not the entire message. - | Good -- Style in a way to emphasize that it is a particularly good - -- thing - | Shell -- Style as a shell command, i.e. when suggesting something to the - -- user that should be typed in directly as written. - | File -- Style as a filename. See 'Dir' for directories. - | Url -- Style as a URL. - | Dir -- Style as a directory name. See 'File' for files. + = Error -- Should be used sparingly, not to style entire long messages. + -- For example, it's used to style the "Error:" or "[error]" label + -- for an error message, not the entire message. + | Warning -- Should be used sparingly, not to style entire long messages. + -- For example, it's used to style the "Warning:" or "[warn]" + -- label for a warning message, not the entire message. + | Info -- Should be used sparingly, not to style entire long messages. + -- For example, it's used to style the "[info]" label for an info + -- message, not the entire message. + | Debug -- Should be used sparingly, not to style entire long messages. + -- For example, it's used to style the "[debug]" label for a debug + -- message, not the entire message. + | OtherLevel -- Should be used sparingly, not to style entire long + -- messages. For example, it's used to style the "[...]" + -- label for an other log level message, not the entire + -- message. + | Good -- Style in a way to emphasize that it is a particularly good + -- thing. + | Shell -- Style as a shell command, i.e. when suggesting something to the + -- user that should be typed in directly as written. + | File -- Style as a filename. See 'Dir' for directories. + | Url -- Style as a URL. + | Dir -- Style as a directory name. See 'File' for files. | Recommendation -- Style used to highlight part of a recommended course of -- action. - | Current -- Style in a way that emphasizes that it is related to a current - -- thing. For example, could be used when talking about the current - -- package we're processing when outputting the name of it. - | Target -- TODO: figure out how to describe this - | Module -- Style as a module name + | Current -- Style in a way that emphasizes that it is related to a current + -- thing. For example, could be used when talking about the current + -- package we're processing when outputting the name of it. + | Target -- TODO: figure out how to describe this + | Module -- Style as a module name. | PkgComponent -- Style used to highlight the named component of a package. + | Secondary -- Style for secondary content. For example, it's used to style + -- timestamps. + | Highlight -- Should be used sparingly, not to style entire long messages. + -- For example, it's used to style the duration in a "Finished + -- process in ... ms" message. deriving (Bounded, Enum, Eq, Ix, Ord, Show) -- |The first style overrides the second. diff --git a/src/Text/PrettyPrint/Leijen/Extended.hs b/src/Text/PrettyPrint/Leijen/Extended.hs --- a/src/Text/PrettyPrint/Leijen/Extended.hs +++ b/src/Text/PrettyPrint/Leijen/Extended.hs @@ -210,7 +210,7 @@ :: (Pretty a, HasLogFunc env, HasStylesUpdate env, MonadReader env m, HasCallStack) => Int -> a -> m Utf8Builder -displayAnsi w = do +displayAnsi w = displayAnsiSimple . renderDefault w . unStyleDoc . pretty {- Not used -------------------------------------------------------------------- @@ -273,15 +273,15 @@ go :: SimpleDoc a -> m (Maybe (SimpleDoc a), Utf8Builder) go SEmpty = return (Nothing, mempty) - go (SChar c x) = liftM (fmap (display c <>)) (go x) + go (SChar c x) = fmap (fmap (display c <>)) (go x) -- NOTE: Could actually use the length to guess at an initial -- allocation. Better yet would be to just use Text in pprint.. - go (SText _l s x) = liftM (fmap (fromString s <>)) (go x) - go (SLine n x) = liftM (fmap ((display '\n' <>) . (spaces n <>))) (go x) + go (SText _l s x) = fmap (fmap (fromString s <>)) (go x) + go (SLine n x) = fmap (fmap ((display '\n' <>) . (spaces n <>))) (go x) go (SAnnotStart ann x) = do (mafter, contents) <- f ann (go x) case mafter of - Just after -> liftM (fmap (contents <>)) (go after) + Just after -> fmap (fmap (contents <>)) (go after) Nothing -> error "Invariant violated by input to displayDecoratedWrap: no matching SAnnotStop for SAnnotStart." go (SAnnotStop x) = return (Just x, mempty)