diff --git a/Data/Aeson/Encode/Pretty.hs b/Data/Aeson/Encode/Pretty.hs index bb8bcfd..498e5bb 100644 --- a/Data/Aeson/Encode/Pretty.hs +++ b/Data/Aeson/Encode/Pretty.hs @@ -7,7 +7,7 @@ module Data.Aeson.Encode.Pretty ( -- * Pretty-Printing with Configuration Options encodePretty', - Config (..), defConfig, + Config (..), defConfig, colorConfig, noColors, -- ** Sorting Keys in Objects -- |With the Aeson library, the order of keys in objects is undefined due -- objects being implemented as HashMaps. To allow user-specified key @@ -53,7 +53,7 @@ module Data.Aeson.Encode.Pretty ( keyOrder ) where -import Data.Aeson (Value(..), ToJSON(..)) +import Data.Aeson (Value(..), ToJSON(..), object) import qualified Data.Aeson.Encode as Aeson import Data.ByteString.Lazy (ByteString) import Data.Function (on) @@ -63,13 +63,15 @@ import Data.Maybe (fromMaybe) import Data.Monoid (mappend, mconcat, mempty) import Data.Ord import Data.Text (Text) -import Data.Text.Lazy.Builder (Builder, toLazyText) +import Data.Text.Lazy.Builder (Builder, toLazyText, fromString) import Data.Text.Lazy.Encoding (encodeUtf8) import qualified Data.Vector as V (toList) +import System.Console.ANSI data PState = PState { pstIndent :: Int , pstLevel :: Int , pstSort :: [(Text, Value)] -> [(Text, Value)] + , pstColor :: Value -> String } data Config = Config @@ -77,6 +79,8 @@ data Config = Config -- ^ Indentation spaces per level of nesting , confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects + , confColor :: Value -> String + -- ^ Map types of values to color codes interpreted by a terminal } -- |Sort keys by their order of appearance in the argument list. @@ -94,7 +98,25 @@ keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks) -- -- > defConfig = Config { confIndent = 4, confCompare = mempty } defConfig :: Config -defConfig = Config { confIndent = 4, confCompare = mempty } +defConfig = Config { confIndent = 4, confCompare = mempty, confColor = noColors } + +-- |Colored default configuration: indent by four spaces per level of nesting, do +-- not sort objects by key, color values. +-- +-- > colorConfig = Config { confIndent = 4, confCompare = mempty } +colorConfig :: Config +colorConfig = defConfig { confColor = defColors } + +noColors :: (Value -> String) +noColors _ = "" + +defColors :: (Value -> String) +defColors (Object _) = setSGRCode [Reset, SetColor Foreground Vivid White] +defColors (Array _) = setSGRCode [Reset, SetColor Foreground Vivid White] +defColors (String _) = setSGRCode [Reset, SetColor Foreground Vivid Green] +defColors (Number _) = setSGRCode [Reset, SetColor Foreground Vivid Blue] +defColors (Bool _) = setSGRCode [Reset, SetColor Foreground Vivid Magenta] +defColors Null = setSGRCode [Reset, SetColor Foreground Dull White] -- |A drop-in replacement for aeson's 'Aeson.encode' function, producing -- JSON-ByteStrings for human readers. @@ -108,15 +130,19 @@ encodePretty = encodePretty' defConfig encodePretty' :: ToJSON a => Config -> a -> ByteString encodePretty' Config{..} = encodeUtf8 . toLazyText . fromValue st . toJSON where - st = PState confIndent 0 condSort + st = PState confIndent 0 condSort confColor condSort = sortBy (confCompare `on` fst) fromValue :: PState -> Value -> Builder fromValue st@PState{..} = go where - go (Array v) = fromCompound st ("[","]") fromValue (V.toList v) - go (Object m) = fromCompound st ("{","}") fromPair (pstSort (H.toList m)) - go v = Aeson.fromValue v + go (Array v) = fromCompound st (punctuation <> "[", punctuation <> "]") fromValue (V.toList v) + go (Object m) = fromCompound st (punctuation <> "{", punctuation <> "}") fromPair (pstSort (H.toList m)) + go v = toColor pstColor v <> Aeson.fromValue v + punctuation = toColor pstColor (object []) + +toColor :: (Value -> String) -> Value -> Builder +toColor toColorCode v = (fromString . toColorCode) v fromCompound :: PState -> (Builder, Builder) @@ -130,13 +156,15 @@ fromCompound st@PState{..} (delimL,delimR) fromItem items = mconcat , delimR ] where - items' = mconcat . intersperse ",\n" $ + items' = mconcat . intersperse (toColor pstColor (object []) <> ",\n") $ map (\item -> fromIndent st' <> fromItem st' item) items st' = st { pstLevel = pstLevel + 1 } fromPair :: PState -> (Text, Value) -> Builder -fromPair st (k,v) = Aeson.fromValue (toJSON k) <> ": " <> fromValue st v +fromPair st@PState{..} (k,v) = + toColor pstColor (object []) <> Aeson.fromValue (toJSON k) + <> toColor pstColor (object []) <> ": " <> fromValue st v fromIndent :: PState -> Builder fromIndent PState{..} = mconcat $ replicate (pstIndent * pstLevel) " " diff --git a/aeson-pretty.cabal b/aeson-pretty.cabal index 19dd2b9..7190c54 100644 --- a/aeson-pretty.cabal +++ b/aeson-pretty.cabal @@ -45,7 +45,8 @@ library bytestring >= 0.9, vector >= 0.9, text >= 0.11, - unordered-containers >= 0.1.3.0 + unordered-containers >= 0.1.3.0, + ansi-terminal >= 0.6 ghc-options: -Wall @@ -62,7 +63,8 @@ executable aeson-pretty attoparsec >= 0.10, base == 4.*, bytestring >= 0.9, - cmdargs >= 0.7 + cmdargs >= 0.7, + ansi-terminal >= 0.6 ghc-options: -Wall ghc-prof-options: -auto-all