{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module Data.Yaml.Pretty.Extras ( module Data.Yaml, module Data.Yaml.Pretty, ToPrettyYaml(..), encodeFilePretty, displayPrettyYaml, PrettyYamlException(..) ) where import Control.Error.Safe import Control.Monad.Except import Data.Yaml import Data.Yaml.Pretty import RIO hiding (tryJust) import qualified RIO.ByteString as BS import RIO.List data PrettyYamlException = FieldNotListed Text [Text] deriving (Typeable) instance Show PrettyYamlException where show (FieldNotListed x as) = "Could not find field " ++ (show x) ++ "in " ++ (show as) exceptElemIndex x as = tryJust (FieldNotListed x as) (elemIndex x as) listElemCmp as x y = either (error . show) id $ runExcept $ liftA2 compare (exceptElemIndex x as) (exceptElemIndex y as) class ToJSON a => ToPrettyYaml a where fieldOrder :: a -> [Text] dropNull :: a -> Bool dropNull = const True toPrettyYaml :: a -> BS.ByteString toPrettyYaml = encodePretty =<< liftM2 setConfDropNull dropNull (flip setConfCompare defConfig . listElemCmp . fieldOrder) encodeFilePretty :: ToPrettyYaml a => FilePath -> a -> IO () encodeFilePretty f x = BS.writeFile f (toPrettyYaml x) displayPrettyYaml :: ToPrettyYaml a => a -> Utf8Builder displayPrettyYaml = displayBytesUtf8 . toPrettyYaml