@@ -0,0 +1,38 @@
1+-- | Prettier YAML encoding.
2+module Data.Yaml.Pretty
3+ ( encodePretty
4+ , Config(..)
5+ , defConfig
6+ ) where
7+
8+import Data.Yaml.Builder
9+import Data.Aeson.Types
10+import Data.Text (Text)
11+import Data.Monoid
12+import qualified Data.Vector as V
13+import qualified Data.HashMap.Strict as HM
14+import Data.Function (on)
15+import Data.List (sortBy)
16+import Data.ByteString (ByteString)
17+import Prelude hiding (null)
18+
19+data Config = Config
20+ { confCompare :: Text -> Text -> Ordering -- ^ Function used to sort keys in objects
21+ }
22+
23+-- | The default configuration: do not sort objects.
24+defConfig :: Config
25+defConfig = Config mempty
26+
27+pretty :: Config -> Value -> YamlBuilder
28+pretty cfg = go
29+ where go (Object o) = mapping (sortBy (confCompare cfg `on` fst) $ HM.toList $ HM.map go o)
30+ go (Array a) = array (fmap go $ V.toList a)
31+ go Null = null
32+ go (String s) = string s
33+ go (Number n) = number n
34+ go (Bool b) = bool b
35+
36+-- | Configurable 'encode'.
37+encodePretty :: ToJSON a => Config -> a -> ByteString
38+encodePretty cfg = toByteString . pretty cfg . toJSON