module Data.Aeson.Encode.Pretty (
encodePretty,
encodePretty',
Config (..), defConfig,
mempty,
compare,
keyOrder
) where
import Data.Aeson (Value(..), ToJSON(..))
import qualified Data.Aeson.Encode as Aeson
import Data.ByteString.Lazy (ByteString)
import Data.Function (on)
import qualified Data.HashMap.Strict as H (toList)
import Data.List (intersperse, sortBy, elemIndex)
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.Encoding (encodeUtf8)
import qualified Data.Vector as V (toList)
data PState = PState { pstIndent :: Int
, pstLevel :: Int
, pstSort :: [(Text, Value)] -> [(Text, Value)]
}
data Config = Config
{ confIndent :: Int
, confCompare :: Text -> Text -> Ordering
}
keyOrder :: [Text] -> Text -> Text -> Ordering
keyOrder ks = comparing $ \k -> fromMaybe maxBound (elemIndex k ks)
defConfig :: Config
defConfig = Config { confIndent = 4, confCompare = mempty }
encodePretty :: ToJSON a => a -> ByteString
encodePretty = encodePretty' defConfig
encodePretty' :: ToJSON a => Config -> a -> ByteString
encodePretty' Config{..} = encodeUtf8 . toLazyText . fromValue st . toJSON
where
st = PState confIndent 0 condSort
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
fromCompound :: PState
-> (Builder, Builder)
-> (PState -> a -> Builder)
-> [a]
-> Builder
fromCompound st@PState{..} (delimL,delimR) fromItem items = mconcat
[ delimL
, if null items then mempty
else "\n" <> items' <> "\n" <> fromIndent st
, delimR
]
where
items' = mconcat . intersperse ",\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
fromIndent :: PState -> Builder
fromIndent PState{..} = mconcat $ replicate (pstIndent * pstLevel) " "
(<>) :: Builder -> Builder -> Builder
(<>) = mappend
infixr 6 <>