1{-# LANGUAGE CPP #-}
2-- | Prettier YAML encoding.
3--
4-- @since 0.8.13
5module Data.Yaml.Pretty
6    ( encodePretty
7    , Config
8    , getConfCompare
9    , setConfCompare
10    , getConfDropNull
11    , setConfDropNull
12    , defConfig
13    , pretty
14    ) where
15
16import Prelude hiding (null)
17
18#if !MIN_VERSION_base(4,8,0)
19import Control.Applicative ((<$>))
20#endif
21import Data.Aeson.Types
22import Data.ByteString (ByteString)
23import Data.Function (on)
24import qualified Data.HashMap.Strict as HM
25import Data.List (sortBy)
26#if !MIN_VERSION_base(4,8,0)
27import Data.Monoid
28#endif
29import Data.Text (Text)
30import qualified Data.Vector as V
31
32import Data.Yaml.Builder
33
34-- |
35-- @since 0.8.13
36data Config = Config
37  { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects
38  , confDropNull :: Bool -- ^ Drop null values from objects
39  }
40
41-- | The default configuration: do not sort objects or drop keys
42--
43-- @since 0.8.13
44defConfig :: Config
45defConfig = Config mempty False
46
47-- |
48-- @since 0.8.13
49getConfCompare :: Config -> Text -> Text -> Ordering
50getConfCompare = confCompare
51
52-- | Sets ordering for object keys
53--
54-- @since 0.8.13
55setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config
56setConfCompare cmp c = c { confCompare = cmp }
57
58-- |
59-- @since 0.8.24
60getConfDropNull :: Config -> Bool
61getConfDropNull = confDropNull
62
63-- | Drop entries with `Null` value from objects, if set to `True`
64--
65-- @since 0.8.24
66setConfDropNull :: Bool -> Config -> Config
67setConfDropNull m c = c { confDropNull = m }
68
69pretty :: Config -> Value -> YamlBuilder
70pretty cfg = go
71  where go (Object o) = let sort = sortBy (confCompare cfg `on` fst)
72                            select
73                              | confDropNull cfg = HM.filter (/= Null)
74                              | otherwise        = id
75                        in mapping (sort $ HM.toList $ HM.map go $ select o)
76        go (Array a)  = array (go <$> V.toList a)
77        go Null       = null
78        go (String s) = string s
79        go (Number n) = scientific n
80        go (Bool b)   = bool b
81
82-- | Configurable 'encode'.
83--
84-- @since 0.8.13
85encodePretty :: ToJSON a => Config -> a -> ByteString
86encodePretty cfg = toByteString . pretty cfg . toJSON
87