diff --git a/rio-prettyprint.cabal b/rio-prettyprint.cabal --- a/rio-prettyprint.cabal +++ b/rio-prettyprint.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: rio-prettyprint -version: 0.1.3.0 +version: 0.1.4.0 synopsis: Pretty-printing for RIO description: Combine RIO's log capabilities with pretty printing category: Development diff --git a/src/RIO/PrettyPrint.hs b/src/RIO/PrettyPrint.hs --- a/src/RIO/PrettyPrint.hs +++ b/src/RIO/PrettyPrint.hs @@ -21,6 +21,7 @@ , logLevelToStyle -- * Formatting utils , bulletedList + , mkNarrativeList , spacedBulletedList , debugBracket -- * Re-exports from "Text.PrettyPrint.Leijen.Extended" @@ -31,6 +32,7 @@ , hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate , fill, fillBreak , enclose, squotes, dquotes, parens, angles, braces, brackets + , string , indentAfterLabel, wordDocs, flow -- * Re-exports from "RIO.PrettyPrint.Types.PrettyPrint" , Style (..) @@ -47,7 +49,7 @@ fill, fillBreak, fillCat, fillSep, group, hang, hcat, hsep, indent, line, linebreak, nest, parens, punctuate, sep, softbreak, softline, squotes, - styleAnn, vcat, vsep) + string, styleAnn, vcat, vsep) class (HasLogFunc env, HasStylesUpdate env) => HasTerm env where useColorL :: Lens' env Bool @@ -170,6 +172,31 @@ -- | Display a bulleted list of 'StyleDoc'. bulletedList :: [StyleDoc] -> StyleDoc bulletedList = mconcat . intersperse line . map (("*" <+>) . align) + +-- | A helper function to yield a narrative list from a list of items, with a +-- final fullstop. For example, helps produce the output +-- @\"apple, ball and cat.\"@ (no serial comma) or @\"apple, ball, and cat.\"@ +-- (serial comma) from @[\"apple\", \"ball\", \"cat\"]@. +-- +-- @since 0.1.4.0 +mkNarrativeList :: Pretty a + => Maybe Style + -- ^ Style the items in the list? + -> Bool + -- ^ Use a serial comma? + -> [a] + -> [StyleDoc] +mkNarrativeList _ _ [] = [] +mkNarrativeList mStyle _ [x] = [maybe id style mStyle (pretty x) <> "."] +mkNarrativeList mStyle useSerialComma [x1, x2] = + mStyle' (pretty x1) <> (if useSerialComma then "," else mempty) + : "and" + : mkNarrativeList mStyle useSerialComma [x2] + where + mStyle' = maybe id style mStyle +mkNarrativeList mStyle useSerialComma (x:xs) = + maybe id style mStyle (pretty x) <> "," + : mkNarrativeList mStyle useSerialComma xs -- | Display a bulleted list of 'StyleDoc' with a blank line between -- each. diff --git a/src/RIO/PrettyPrint/PrettyException.hs b/src/RIO/PrettyPrint/PrettyException.hs --- a/src/RIO/PrettyPrint/PrettyException.hs +++ b/src/RIO/PrettyPrint/PrettyException.hs @@ -1,79 +1,77 @@ {-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE ExistentialQuantification #-} - -{-| -This module provides a type representing pretty exceptions. It can be used as in -the example below: - -@ -{-# LANGUAGE NoImplicitPrelude #-} -{-# LANGUAGE OverloadedStrings #-} - -module Main (main) where - -import RIO - ( Exception, Handler (..), IO, RIO, Show, SomeException (..), Typeable - , ($), catches, displayException, exitFailure, fromString, logError - , mempty, throwIO - ) -import RIO.PrettyPrint - ( Pretty (..), Style (..), (<+>), prettyError, prettyInfo, style ) -import RIO.PrettyPrint.PrettyException ( PrettyException (..) ) -import RIO.PrettyPrint.Simple ( SimplePrettyApp, runSimplePrettyApp ) - -main :: IO () -main = runSimplePrettyApp 80 mempty (action `catches` handleExceptions) - where - action :: RIO SimplePrettyApp () - action = do - prettyInfo "Running action!" - throwIO (PrettyException MyPrettyException) - - handleExceptions :: [Handler (RIO SimplePrettyApp) ()] - handleExceptions = - [ Handler handlePrettyException - , Handler handleSomeException - ] - - handlePrettyException :: PrettyException -> RIO SimplePrettyApp () - handlePrettyException e = do - prettyError $ pretty e - exitFailure - - handleSomeException :: SomeException -> RIO SimplePrettyApp () - handleSomeException (SomeException e) = do - logError $ fromString $ displayException e - exitFailure - -data MyPrettyException - = MyPrettyException - deriving (Show, Typeable) - -instance Pretty MyPrettyException where - pretty MyPrettyException = - "My" <+> style Highlight "pretty" <+> "exception!" +{-# LANGUAGE StandaloneDeriving #-} -instance Exception MyPrettyException -@ --} +-- | This module provides a type representing pretty exceptions. It can be used +-- as in the example below: +-- +-- > {-# LANGUAGE NoImplicitPrelude #-} +-- > {-# LANGUAGE OverloadedStrings #-} +-- > +-- > module Main (main) where +-- > +-- > import RIO +-- > ( Exception, Handler (..), IO, RIO, Show, SomeException (..), Typeable +-- > , ($), catches, displayException, exitFailure, fromString, logError +-- > , mempty, throwIO +-- > ) +-- > import RIO.PrettyPrint +-- > ( Pretty (..), Style (..), (<+>), prettyError, prettyInfo, style ) +-- > import RIO.PrettyPrint.PrettyException ( PrettyException (..) ) +-- > import RIO.PrettyPrint.Simple ( SimplePrettyApp, runSimplePrettyApp ) +-- > +-- > main :: IO () +-- > main = runSimplePrettyApp 80 mempty (action `catches` handleExceptions) +-- > where +-- > action :: RIO SimplePrettyApp () +-- > action = do +-- > prettyInfo "Running action!" +-- > throwIO (PrettyException MyPrettyException) +-- > +-- > handleExceptions :: [Handler (RIO SimplePrettyApp) ()] +-- > handleExceptions = +-- > [ Handler handlePrettyException +-- > , Handler handleSomeException +-- > ] +-- > +-- > handlePrettyException :: PrettyException -> RIO SimplePrettyApp () +-- > handlePrettyException e = do +-- > prettyError $ pretty e +-- > exitFailure +-- > +-- > handleSomeException :: SomeException -> RIO SimplePrettyApp () +-- > handleSomeException (SomeException e) = do +-- > logError $ fromString $ displayException e +-- > exitFailure +-- > +-- > data MyPrettyException +-- > = MyPrettyException +-- > deriving (Show, Typeable) +-- > +-- > instance Pretty MyPrettyException where +-- > pretty MyPrettyException = +-- > "My" <+> style Highlight "pretty" <+> "exception!" +-- > +-- > instance Exception MyPrettyException +-- module RIO.PrettyPrint.PrettyException ( PrettyException (..) ) where -import RIO (Exception, Show (..), Typeable) +import RIO (Exception (..), Show, Typeable) import Text.PrettyPrint.Leijen.Extended (Pretty (..)) -- | Type representing pretty exceptions. -- --- @since 0.1.3.0 +-- @since 0.1.4.0 data PrettyException = forall e. (Exception e, Pretty e) => PrettyException e deriving Typeable -instance Show PrettyException where - show (PrettyException e) = show e +deriving instance Show PrettyException instance Pretty PrettyException where pretty (PrettyException e) = pretty e -instance Exception PrettyException +instance Exception PrettyException where + displayException (PrettyException e) = displayException e 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 @@ -86,11 +86,12 @@ -- @ -- ** Primitive type documents - -- Entirely omitted: + -- Omitted compared to the original: -- -- @ - -- string, int, integer, float, double, rational, bool, + -- int, integer, float, double, rational, bool, -- @ + string, -- ** Semantic annotations annotate, noAnnotate, styleAnn @@ -173,7 +174,7 @@ -- |A document annotated by a style newtype StyleDoc = StyleDoc { unStyleDoc :: Doc StyleAnn } - deriving IsString + deriving (IsString, Show) -- |An ANSI code(s) annotation. newtype AnsiAnn = AnsiAnn [SGR] @@ -385,6 +386,17 @@ brackets :: StyleDoc -> StyleDoc brackets = StyleDoc . P.brackets . unStyleDoc + +-- | The document @string s@ concatenates all characters in @s@ using @line@ for +-- newline characters and @char@ for all other characters. It is used whenever +-- the text contains newline characters. +-- +-- @since 0.1.4.0 +string :: String -> StyleDoc +string "" = mempty +string ('\n':s) = line <> string s +string s = let (xs, ys) = span (/='\n') s + in fromString xs <> string ys annotate :: StyleAnn -> StyleDoc -> StyleDoc annotate a = StyleDoc . P.annotate a . unStyleDoc