module Data.Yaml.Pretty.Extras
( module Data.Yaml
, module Data.Yaml.Pretty
, ToPrettyYaml(..)
, encodeFilePretty
, displayPrettyYaml
, decodeFileThrowLogged
, encodeFilePrettyLogged
, transformFile
, inplace
, sanitizeFile
, overFile
, traverseOfFile
)
where
import Data.Typeable
import Data.Yaml
import Data.Yaml.Pretty
import Lens.Micro.Platform
import RIO
import qualified RIO.ByteString as BS
import RIO.List
listElemCmp as x y =
fromMaybe LT $ liftA2 compare (elemIndex x as) (elemIndex 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 :: (MonadIO m) => ToPrettyYaml a => FilePath -> a -> m ()
encodeFilePretty f x = BS.writeFile f (toPrettyYaml x)
displayPrettyYaml :: ToPrettyYaml a => a -> Utf8Builder
displayPrettyYaml = displayBytesUtf8 . toPrettyYaml
decodeFileThrowLogged
:: ( MonadReader env m
, MonadIO m
, HasLogFunc env
, FromJSON b
, ToPrettyYaml b
, Typeable b
)
=> FilePath
-> m b
decodeFileThrowLogged x = do
logInfo $ "Loading " <> displayShow x
(t :: b) <- decodeFileThrow x
logInfo $ mconcat
[ "Loaded "
, displayShow x
, " as "
, displayShow (typeOf t)
, " with contents\n"
, displayPrettyYaml t
]
return t
encodeFilePrettyLogged
:: ( MonadReader env m
, MonadIO m
, HasLogFunc env
, ToPrettyYaml b
, Typeable b
)
=> FilePath
-> b
-> m ()
encodeFilePrettyLogged x d = do
logInfo $ mconcat
[ "Saving "
, displayShow (typeOf d)
, " with contents:\n"
, displayPrettyYaml d
, " to "
, displayShow x
]
encodeFilePretty x d
logInfo $ "Saved " <> displayShow x
transformFile
:: (MonadIO m, FromJSON a1, ToPrettyYaml a2) =>
FilePath -> FilePath -> (a1 -> a2) -> m a2
transformFile f g l = do
(x :: a1) <- decodeFileThrow f
encodeFilePretty g (l x)
return (l x)
inplace :: (FilePath -> FilePath -> a) -> FilePath -> a
inplace = join
sanitizeFile
:: (MonadIO m, FromJSON a, ToPrettyYaml a) =>
FilePath -> m a
sanitizeFile = flip (inplace transformFile) id
overFile
:: (MonadIO m, FromJSON a1, ToPrettyYaml a2) =>
FilePath -> FilePath -> ASetter a1 a2 a b -> (a -> b) -> m a2
overFile f g l a = transformFile f g (over l a)
traverseOfFile
:: (MonadIO m, FromJSON a1, ToPrettyYaml a2) =>
FilePath -> FilePath -> LensLike m a1 a2 b1 b2 -> (b1 -> m b2) -> m a2
traverseOfFile f g l a = do
(x :: a1) <- decodeFileThrow f
y <- traverseOf l a x
encodeFilePretty g y
return y