{-# LANGUAGE CPP #-}
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.Bifunctor (first)
#if MIN_VERSION_aeson(2,0,0)
import qualified Data.Aeson.Key as K
import qualified Data.Aeson.KeyMap as HM
#else
import qualified Data.HashMap.Strict as HM
#endif
import Data.Aeson.Types
import Data.ByteString (ByteString)
import Data.Function (on)
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
#if MIN_VERSION_aeson(2,0,0)
toText :: Key -> Text
toText = K.toText
#else
toText :: Key -> Text
toText :: Key -> Key
toText = Key -> Key
forall a. a -> a
id
type Key = Text
#endif
data Config = Config
{ Config -> Key -> Key -> Ordering
confCompare :: Text -> Text -> Ordering
, Config -> Bool
confDropNull :: Bool
}
defConfig :: Config
defConfig :: Config
defConfig = (Key -> Key -> Ordering) -> Bool -> Config
Config Key -> Key -> Ordering
forall a. Monoid a => a
mempty Bool
False
getConfCompare :: Config -> Text -> Text -> Ordering
getConfCompare :: Config -> Key -> Key -> Ordering
getConfCompare = Config -> Key -> Key -> Ordering
confCompare
setConfCompare :: (Text -> Text -> Ordering) -> Config -> Config
setConfCompare :: (Key -> Key -> Ordering) -> Config -> Config
setConfCompare Key -> Key -> Ordering
cmp Config
c = Config
c { confCompare :: Key -> Key -> Ordering
confCompare = Key -> Key -> Ordering
cmp }
getConfDropNull :: Config -> Bool
getConfDropNull :: Config -> Bool
getConfDropNull = Config -> Bool
confDropNull
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 :: [(Key, b)] -> [(Key, b)]
sort = ((Key, b) -> (Key, b) -> Ordering) -> [(Key, b)] -> [(Key, b)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Config -> Key -> Key -> Ordering
confCompare Config
cfg (Key -> Key -> Ordering)
-> ((Key, b) -> Key) -> (Key, b) -> (Key, b) -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (Key, b) -> Key
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 [(Key, YamlBuilder)] -> YamlBuilder
mapping ([(Key, YamlBuilder)] -> [(Key, YamlBuilder)]
forall b. [(Key, b)] -> [(Key, b)]
sort ([(Key, YamlBuilder)] -> [(Key, YamlBuilder)])
-> [(Key, YamlBuilder)] -> [(Key, YamlBuilder)]
forall a b. (a -> b) -> a -> b
$ ((Key, YamlBuilder) -> (Key, YamlBuilder))
-> [(Key, YamlBuilder)] -> [(Key, YamlBuilder)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Key -> Key) -> (Key, YamlBuilder) -> (Key, YamlBuilder)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Key -> Key
toText) ([(Key, YamlBuilder)] -> [(Key, YamlBuilder)])
-> [(Key, YamlBuilder)] -> [(Key, YamlBuilder)]
forall a b. (a -> b) -> a -> b
$ HashMap Key YamlBuilder -> [(Key, YamlBuilder)]
forall k v. HashMap k v -> [(k, v)]
HM.toList (HashMap Key YamlBuilder -> [(Key, YamlBuilder)])
-> HashMap Key YamlBuilder -> [(Key, YamlBuilder)]
forall a b. (a -> b) -> a -> b
$ (Value -> YamlBuilder) -> Object -> HashMap Key YamlBuilder
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map Value -> YamlBuilder
go (Object -> HashMap Key YamlBuilder)
-> Object -> HashMap Key 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 Key
s) = Key -> YamlBuilder
string Key
s
go (Number Scientific
n) = Scientific -> YamlBuilder
scientific Scientific
n
go (Bool Bool
b) = Bool -> YamlBuilder
bool Bool
b
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