Add an option to color the output

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,20 +63,24 @@ 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
     { confIndent  :: Int
       -- ^ 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) " "

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