1{-# LANGUAGE OverloadedStrings, RecordWildCards #-} 2 3-- |Aeson-compatible pretty-printing of JSON 'Value's. 4module Data.Aeson.Encode.Pretty ( 5 -- * Simple Pretty-Printing 6 encodePretty, encodePrettyToTextBuilder, 7 8 -- * Pretty-Printing with Configuration Options 9 encodePretty', encodePrettyToTextBuilder', 10 Config (..), defConfig, 11 Indent(..), NumberFormat(..), 12 -- ** Sorting Keys in Objects 13 -- |With the Aeson library, the order of keys in objects is undefined due to 14 -- objects being implemented as HashMaps. To allow user-specified key 15 -- orders in the pretty-printed JSON, 'encodePretty'' can be configured 16 -- with a comparison function. These comparison functions can be composed 17 -- using the 'Monoid' interface. Some other useful helper functions to keep 18 -- in mind are 'comparing' and 'on'. 19 -- 20 -- Consider the following deliberately convoluted example, demonstrating 21 -- the use of comparison functions: 22 -- 23 -- An object might pretty-print as follows 24 -- 25 -- > { 26 -- > "baz": ..., 27 -- > "bar": ..., 28 -- > "foo": ..., 29 -- > "quux": ..., 30 -- > } 31 -- 32 -- which is clearly a confusing order of keys. By using a comparison 33 -- function such as 34 -- 35 -- > comp :: Text -> Text -> Ordering 36 -- > comp = keyOrder ["foo","bar"] `mappend` comparing length 37 -- 38 -- we can achieve the desired neat result: 39 -- 40 -- > { 41 -- > "foo": ..., 42 -- > "bar": ..., 43 -- > "baz": ..., 44 -- > "quux": ..., 45 -- > } 46 -- 47 48 mempty, 49 -- |Serves as an order-preserving (non-)sort function. Re-exported from 50 -- "Data.Monoid". 51 compare, 52 -- |Sort keys in their natural order, i.e. by comparing character codes. 53 -- Re-exported from the Prelude and "Data.Ord" 54 keyOrder 55) where 56 57import Data.Aeson (Value(..), ToJSON(..)) 58import qualified Data.Aeson.Encode as Aeson 59import Data.ByteString.Lazy (ByteString) 60import Data.Function (on) 61import qualified Data.HashMap.Strict as H (toList) 62import Data.List (intersperse, sortBy, elemIndex) 63import Data.Maybe (fromMaybe) 64import Data.Semigroup ((<>)) 65import qualified Data.Scientific as S (Scientific, FPFormat(..)) 66import Data.Ord (comparing) 67import Data.Text (Text) 68import Data.Text.Lazy.Builder (Builder, toLazyText) 69import Data.Text.Lazy.Builder.Scientific (formatScientificBuilder) 70import Data.Text.Lazy.Encoding (encodeUtf8) 71import qualified Data.Vector as V (toList) 72import Prelude () 73import Prelude.Compat 74 75 76data PState = PState { pLevel :: Int 77 , pIndent :: Builder 78 , pNewline :: Builder 79 , pItemSep :: Builder 80 , pKeyValSep :: Builder 81 , pNumFormat :: NumberFormat 82 , pSort :: [(Text, Value)] -> [(Text, Value)] 83 } 84 85-- | Indentation per level of nesting. @'Spaces' 0@ removes __all__ whitespace 86-- from the output. 87data Indent = Spaces Int | Tab 88 89data NumberFormat 90 -- | The standard behaviour of the 'Aeson.encode' function. Uses 91 -- integer literals for integers (1, 2, 3...), simple decimals 92 -- for fractional values between 0.1 and 9,999,999, and scientific 93 -- notation otherwise. 94 = Generic 95 -- | Scientific notation (e.g. 2.3e123). 96 | Scientific 97 -- | Standard decimal notation 98 | Decimal 99 -- | Custom formatting function 100 | Custom (S.Scientific -> Builder) 101 102data Config = Config 103 { confIndent :: Indent 104 -- ^ Indentation per level of nesting 105 , confCompare :: Text -> Text -> Ordering 106 -- ^ Function used to sort keys in objects 107 , confNumFormat :: NumberFormat 108 , confTrailingNewline :: Bool 109 -- ^ Whether to add a trailing newline to the output 110 } 111 112-- |Sort keys by their order of appearance in the argument list. 113-- 114-- Keys that are not present in the argument list are considered to be greater 115-- than any key in the list and equal to all keys not in the list. I.e. keys 116-- not in the argument list are moved to the end, while their order is 117-- preserved. 118keyOrder :: [Text] -> Text -> Text -> Ordering 119keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks) 120 121 122-- |The default configuration: indent by four spaces per level of nesting, do 123-- not sort objects by key, do not add trailing newline. 124-- 125-- > defConfig = Config { confIndent = Spaces 4, confCompare = mempty, confNumFormat = Generic, confTrailingNewline = False } 126defConfig :: Config 127defConfig = 128 Config {confIndent = Spaces 4, confCompare = mempty, confNumFormat = Generic, confTrailingNewline = False} 129 130-- |A drop-in replacement for aeson's 'Aeson.encode' function, producing 131-- JSON-ByteStrings for human readers. 132-- 133-- Follows the default configuration in 'defConfig'. 134encodePretty :: ToJSON a => a -> ByteString 135encodePretty = encodePretty' defConfig 136 137-- |A variant of 'encodePretty' that takes an additional configuration 138-- parameter. 139encodePretty' :: ToJSON a => Config -> a -> ByteString 140encodePretty' conf = encodeUtf8 . toLazyText . encodePrettyToTextBuilder' conf 141 142-- |A drop-in replacement for aeson's 'Aeson.encodeToTextBuilder' function, 143-- producing JSON-ByteStrings for human readers. 144-- 145-- Follows the default configuration in 'defConfig'. 146encodePrettyToTextBuilder :: ToJSON a => a -> Builder 147encodePrettyToTextBuilder = encodePrettyToTextBuilder' defConfig 148 149-- |A variant of 'encodeToTextBuilder' that takes an additional configuration 150-- parameter. 151encodePrettyToTextBuilder' :: ToJSON a => Config -> a -> Builder 152encodePrettyToTextBuilder' Config{..} x = fromValue st (toJSON x) <> trail 153 where 154 st = PState 0 indent newline itemSep kvSep confNumFormat sortFn 155 indent = case confIndent of 156 Spaces n -> mconcat (replicate n " ") 157 Tab -> "\t" 158 newline = case confIndent of 159 Spaces 0 -> "" 160 _ -> "\n" 161 itemSep = "," 162 kvSep = case confIndent of 163 Spaces 0 -> ":" 164 _ -> ": " 165 sortFn = sortBy (confCompare `on` fst) 166 trail = if confTrailingNewline then "\n" else "" 167 168 169fromValue :: PState -> Value -> Builder 170fromValue st@PState{..} val = go val 171 where 172 go (Array v) = fromCompound st ("[","]") fromValue (V.toList v) 173 go (Object m) = fromCompound st ("{","}") fromPair (pSort (H.toList m)) 174 go (Number x) = fromNumber st x 175 go v = Aeson.encodeToTextBuilder v 176 177fromCompound :: PState 178 -> (Builder, Builder) 179 -> (PState -> a -> Builder) 180 -> [a] 181 -> Builder 182fromCompound st@PState{..} (delimL,delimR) fromItem items = mconcat 183 [ delimL 184 , if null items then mempty 185 else pNewline <> items' <> pNewline <> fromIndent st 186 , delimR 187 ] 188 where 189 items' = mconcat . intersperse (pItemSep <> pNewline) $ 190 map (\item -> fromIndent st' <> fromItem st' item) 191 items 192 st' = st { pLevel = pLevel + 1} 193 194fromPair :: PState -> (Text, Value) -> Builder 195fromPair st (k,v) = 196 Aeson.encodeToTextBuilder (toJSON k) <> pKeyValSep st <> fromValue st v 197 198fromIndent :: PState -> Builder 199fromIndent PState{..} = mconcat (replicate pLevel pIndent) 200 201fromNumber :: PState -> S.Scientific -> Builder 202fromNumber st x = case pNumFormat st of 203 Generic 204 | (x > 1.0e19 || x < -1.0e19) -> formatScientificBuilder S.Exponent Nothing x 205 | otherwise -> Aeson.encodeToTextBuilder $ Number x 206 Scientific -> formatScientificBuilder S.Exponent Nothing x 207 Decimal -> formatScientificBuilder S.Fixed Nothing x 208 Custom f -> f x 209