-- | Haskell re-implementation of [cfn_flip](https://github.com/awslabs/aws-cfn-template-flip/blob/837aa56e21cb00b1c7fa0150f0fd38365c508e4e/cfn_flip/yaml_dumper.py)
module CfnFlip
  ( yamlFileToJson
  , yamlToJson
  , jsonToYamlFile
  , jsonFileToYaml
  , jsonToYaml
  ) where

import CfnFlip.Prelude

import CfnFlip.Aeson
import qualified CfnFlip.JsonToYaml as JsonToYaml
import qualified CfnFlip.Yaml as Yaml
import qualified CfnFlip.YamlToJson as YamlToJson

-- | Read a file of Yaml and produce a @'FromJSON' a@
yamlFileToJson :: (MonadIO m, FromJSON a) => FilePath -> m a
yamlFileToJson :: forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
yamlFileToJson = forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
ByteString -> m a
yamlToJson forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *). MonadIO m => FilePath -> m ByteString
readFileBinary

-- | Convert a 'ByteString' of Yaml to a @'FromJSON' a@
yamlToJson :: (MonadIO m, FromJSON a) => ByteString -> m a
yamlToJson :: forall (m :: * -> *) a.
(MonadIO m, FromJSON a) =>
ByteString -> m a
yamlToJson = forall {m :: * -> *} {a}.
(MonadIO m, FromJSON a) =>
ConduitT Event Event Parse () -> ByteString -> m a
Yaml.decode forall (m :: * -> *). MonadIO m => ConduitT Event Event m ()
YamlToJson.translate

-- | Write a @'ToJSON a@ to a file as Yaml
jsonToYamlFile :: (MonadUnliftIO m, ToJSON a) => FilePath -> a -> m ()
jsonToYamlFile :: forall (m :: * -> *) a.
(MonadUnliftIO m, ToJSON a) =>
FilePath -> a -> m ()
jsonToYamlFile FilePath
path = forall (m :: * -> *). MonadIO m => FilePath -> ByteString -> m ()
writeFileBinary FilePath
path forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a.
(MonadUnliftIO m, ToJSON a) =>
a -> m ByteString
jsonToYaml

-- | Read a file of JSON and produce a 'ByteString' of Yaml
--
-- NB. The conversion occurs at 'Value'.
--
jsonFileToYaml :: MonadUnliftIO m => FilePath -> m ByteString
jsonFileToYaml :: forall (m :: * -> *). MonadUnliftIO m => FilePath -> m ByteString
jsonFileToYaml = forall (m :: * -> *) a.
(MonadUnliftIO m, ToJSON a) =>
a -> m ByteString
jsonToYaml @_ @Value forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
eitherDecodeFileStrictThrow

-- | Convert a 'ToJSON a' to a 'ByteString' of Yaml
jsonToYaml :: (MonadUnliftIO m, ToJSON a) => a -> m ByteString
jsonToYaml :: forall (m :: * -> *) a.
(MonadUnliftIO m, ToJSON a) =>
a -> m ByteString
jsonToYaml = forall (m :: * -> *) a.
(MonadUnliftIO m, ToJSON a) =>
ConduitT Event Event (ResourceT m) () -> a -> m ByteString
Yaml.encode forall (m :: * -> *). MonadIO m => ConduitT Event Event m ()
JsonToYaml.translate