{-# LANGUAGE CPP #-}
-- | Prettier YAML encoding.
--
-- @since 0.8.13
module Data.Yaml.Pretty
    ( encodePretty
    , Config
    , getConfCompare
    , setConfCompare
    , getConfDropNull
    , setConfDropNull
    , defConfig
    , pretty
    ) where

import Prelude hiding (null)

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>))
#endif
import Data.Bifunctor (first)
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as HM
#else
import qualified Data.HashMap.Strict as HM
#endif
import Data.Aeson.Types
import Data.ByteString (ByteString)
import Data.Function (on)
import Data.List (sortBy)
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import Data.Text (Text)
import qualified Data.Vector as V

import Data.Yaml.Builder

#if MIN_VERSION_aeson(2,0,0)
toText :: Key -> Text
toText :: Key -> Text
toText = Key -> Text
K.toText
#else
toText :: Key -> Text
toText = id

type Key = Text
#endif

-- |
-- @since 0.8.13
data Config = Config
  { Config -> Text -> Text -> Ordering
confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects
  , Config -> Bool
confDropNull :: Bool -- ^ Drop null values from objects
  }

-- | The default configuration: do not sort objects or drop keys
--
-- @since 0.8.13
defConfig :: Config
defConfig :: Config
defConfig = (Text -> Text -> Ordering) -> Bool -> Config
Config forall a. Monoid a => a
mempty Bool
False

-- |
-- @since 0.8.13
getConfCompare :: Config -> Text -> Text -> Ordering
getConfCompare :: Config -> Text -> Text -> Ordering
getConfCompare = Config -> Text -> Text -> Ordering
confCompare

-- | Sets ordering for object keys
--
-- @since 0.8.13
setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config
setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config
setConfCompare Text -> Text -> Ordering
cmp Config
c = Config
c { confCompare :: Text -> Text -> Ordering
confCompare = Text -> Text -> Ordering
cmp }

-- |
-- @since 0.8.24
getConfDropNull :: Config -> Bool
getConfDropNull :: Config -> Bool
getConfDropNull = Config -> Bool
confDropNull

-- | Drop entries with `Null` value from objects, if set to `True`
--
-- @since 0.8.24
setConfDropNull :: Bool -> Config -> Config
setConfDropNull :: Bool -> Config -> Config
setConfDropNull Bool
m Config
c = Config
c { confDropNull :: Bool
confDropNull = Bool
m }

pretty :: Config -> Value -> YamlBuilder
pretty :: Config -> Value -> YamlBuilder
pretty Config
cfg = Value -> YamlBuilder
go
  where go :: Value -> YamlBuilder
go (Object Object
o) = let sort :: [(Text, b)] -> [(Text, b)]
sort = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Config -> Text -> Text -> Ordering
confCompare Config
cfg forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> a
fst)
                            select :: Object -> Object
select
                              | Config -> Bool
confDropNull Config
cfg = forall v. (v -> Bool) -> KeyMap v -> KeyMap v
HM.filter (forall a. Eq a => a -> a -> Bool
/= Value
Null)
                              | Bool
otherwise        = forall a. a -> a
id
                        in [(Text, YamlBuilder)] -> YamlBuilder
mapping (forall {b}. [(Text, b)] -> [(Text, b)]
sort forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Text
toText) forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> [(Key, v)]
HM.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> KeyMap a -> KeyMap b
HM.map Value -> YamlBuilder
go forall a b. (a -> b) -> a -> b
$ Object -> Object
select Object
o)
        go (Array Array
a)  = [YamlBuilder] -> YamlBuilder
array (Value -> YamlBuilder
go forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Vector a -> [a]
V.toList Array
a)
        go Value
Null       = YamlBuilder
null
        go (String Text
s) = Text -> YamlBuilder
string Text
s
        go (Number Scientific
n) = Scientific -> YamlBuilder
scientific Scientific
n
        go (Bool Bool
b)   = Bool -> YamlBuilder
bool Bool
b

-- | Configurable 'encode'.
--
-- @since 0.8.13
encodePretty :: ToJSON a => Config -> a -> ByteString
encodePretty :: forall a. ToJSON a => Config -> a -> ByteString
encodePretty Config
cfg = forall a. ToYaml a => a -> ByteString
toByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> YamlBuilder
pretty Config
cfg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON