{-# 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.Aeson.Types
import Data.ByteString (ByteString)
import Data.Function (on)
import qualified Data.HashMap.Strict as HM
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

-- |
-- @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 Text -> Text -> Ordering
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 = ((Text, b) -> (Text, b) -> Ordering) -> [(Text, b)] -> [(Text, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Config -> Text -> Text -> Ordering
confCompare Config
cfg (Text -> Text -> Ordering)
-> ((Text, b) -> Text) -> (Text, b) -> (Text, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Text, b) -> Text
forall a b. (a, b) -> a
fst)
                            select :: HashMap k Value -> HashMap k Value
select
                              | Config -> Bool
confDropNull Config
cfg = (Value -> Bool) -> HashMap k Value -> HashMap k Value
forall v k. (v -> Bool) -> HashMap k v -> HashMap k v
HM.filter (Value -> Value -> Bool
forall a. Eq a => a -> a -> Bool
/= Value
Null)
                              | Bool
otherwise        = HashMap k Value -> HashMap k Value
forall a. a -> a
id
                        in [(Text, YamlBuilder)] -> YamlBuilder
mapping ([(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall b. [(Text, b)] -> [(Text, b)]
sort ([(Text, YamlBuilder)] -> [(Text, YamlBuilder)])
-> [(Text, YamlBuilder)] -> [(Text, YamlBuilder)]
forall a b. (a -> b) -> a -> b
$ HashMap Text YamlBuilder -> [(Text, YamlBuilder)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Text YamlBuilder -> [(Text, YamlBuilder)])
-> HashMap Text YamlBuilder -> [(Text, YamlBuilder)]
forall a b. (a -> b) -> a -> b
$ (Value -> YamlBuilder) -> Object -> HashMap Text YamlBuilder
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Value -> YamlBuilder
go (Object -> HashMap Text YamlBuilder)
-> Object -> HashMap Text YamlBuilder
forall a b. (a -> b) -> a -> b
$ Object -> Object
forall k. HashMap k Value -> HashMap k Value
select Object
o)
        go (Array Array
a)  = [YamlBuilder] -> YamlBuilder
array (Value -> YamlBuilder
go (Value -> YamlBuilder) -> [Value] -> [YamlBuilder]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Value]
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 :: Config -> a -> ByteString
encodePretty Config
cfg = YamlBuilder -> ByteString
forall a. ToYaml a => a -> ByteString
toByteString (YamlBuilder -> ByteString)
-> (a -> YamlBuilder) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> YamlBuilder
pretty Config
cfg (Value -> YamlBuilder) -> (a -> Value) -> a -> YamlBuilder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON