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