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