@@ -7,6 +7,7 @@ module Data.Yaml.Pretty
77 , Config
88 , getConfCompare
99 , setConfCompare
10+ , setConfComparePos
1011 , getConfDropNull
1112 , setConfDropNull
1213 , defConfig
@@ -50,7 +51,7 @@ type Key = Text
5051-- |
5152-- @since 0.8.13
5253data Config = Config
53− { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects
54+ { confCompare :: JSONPath -> Text -> Text -> Ordering -- ^ Function used to sort keys in objects
5455 , confDropNull :: Bool -- ^ Drop null values from objects
5556 }
5657
@@ -62,14 +63,20 @@ defConfig = Config mempty False
6263
6364-- |
6465-- @since 0.8.13
65−getConfCompare :: Config -> Text -> Text -> Ordering
66+getConfCompare :: Config -> JSONPath -> Text -> Text -> Ordering
6667getConfCompare = confCompare
6768
6869-- | Sets ordering for object keys
6970--
7071-- @since 0.8.13
7172setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config
72−setConfCompare cmp c = c { confCompare = cmp }
73+setConfCompare cmp c = c { confCompare = \_ps -> cmp }
74+
75+-- | Set ordering for object keys that depends on location of object in the document.
76+--
77+-- @since 0.11.9
78+setConfComparePos :: (JSONPath -> Text -> Text -> Ordering) -> Config -> Config
79+setConfComparePos cmp c = c { confCompare = cmp }
7380
7481-- |
7582-- @since 0.8.24
@@ -83,17 +90,17 @@ setConfDropNull :: Bool -> Config -> Config
8390setConfDropNull m c = c { confDropNull = m }
8491
8592pretty :: Config -> Value -> YamlBuilder
86−pretty cfg = go
87− where go (Object o) = let sort = sortBy (confCompare cfg `on` fst)
88− select
89− | confDropNull cfg = HM.filter (/= Null)
90− | otherwise = id
91− in mapping (sort $ fmap (first toText) $ HM.toList $ HM.map go $ select o)
92− go (Array a) = array (go <$> V.toList a)
93− go Null = null
94− go (String s) = string s
95− go (Number n) = scientific n
96− go (Bool b) = bool b
93+pretty cfg = go []
94+ where go ps (Object o) = let sort = sortBy (confCompare cfg (reverse ps) `on` fst)
95+ select
96+ | confDropNull cfg = HM.filter (/= Null)
97+ | otherwise = id
98+ in mapping (sort $ fmap (first toText) $ HM.toList $ HM.mapWithKey (\k -> go (Key (toText k): ps)) $ select o)
99+ go ps (Array a) = array $ zipWith (\ix -> go (Index ix: ps)) [0..] (V.toList a)
100+ go _ Null = null
101+ go _ (String s) = string s
102+ go _ (Number n) = scientific n
103+ go _ (Bool b) = bool b
97104
98105-- | Configurable 'encode'.
99106--