{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Dhall.JSON.Yaml
( Options(..)
, parseDocuments
, parseQuoted
, defaultOptions
, dhallToYaml
, jsonToYaml
, generatedCodeNotice
) where
import Data.ByteString (ByteString)
import Data.Text (Text)
import Dhall.JSON (Conversion (..), SpecialDoubleMode (..))
import Dhall.Parser (Header(..))
import Options.Applicative (Parser)
import qualified Data.Aeson
import qualified Data.Aeson.Yaml
import qualified Data.ByteString.Lazy
import qualified Data.Text.Encoding
import qualified Data.Vector
import qualified Dhall
import qualified Dhall.JSON
import qualified Options.Applicative
data Options = Options
{ Options -> Bool
explain :: Bool
, Options -> Value -> Value
omission :: Data.Aeson.Value -> Data.Aeson.Value
, Options -> Bool
documents :: Bool
, Options -> Bool
quoted :: Bool
, Options -> Conversion
conversion :: Conversion
, Options -> Maybe FilePath
file :: Maybe FilePath
, Options -> Maybe FilePath
output :: Maybe FilePath
, Options -> Bool
noEdit :: Bool
, :: Bool
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions =
Options { explain :: Bool
explain = Bool
False
, omission :: Value -> Value
omission = forall a. a -> a
id
, documents :: Bool
documents = Bool
False
, quoted :: Bool
quoted = Bool
False
, conversion :: Conversion
conversion = Conversion
Dhall.JSON.defaultConversion
, file :: Maybe FilePath
file = forall a. Maybe a
Nothing
, output :: Maybe FilePath
output = forall a. Maybe a
Nothing
, noEdit :: Bool
noEdit = Bool
False
, preserveHeader :: Bool
preserveHeader = Bool
False
}
parseDocuments :: Parser Bool
parseDocuments :: Parser Bool
parseDocuments =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"documents"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help FilePath
"If given a Dhall list, output a document for every element. Each document, including the first one, will be preceded by \"---\", even if there is only one document. If not given a list, output a single document (as if it were a list of one element)"
)
parseQuoted :: Parser Bool
parseQuoted :: Parser Bool
parseQuoted =
Mod FlagFields Bool -> Parser Bool
Options.Applicative.switch
( forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
Options.Applicative.long FilePath
"quoted"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
Options.Applicative.help FilePath
"Prevent from generating not quoted scalars"
)
generatedCodeNotice :: ByteString
generatedCodeNotice :: ByteString
generatedCodeNotice = ByteString
"# Code generated by dhall-to-yaml. DO NOT EDIT.\n"
dhallToYaml
:: Options
-> Maybe FilePath
-> Text
-> IO ByteString
dhallToYaml :: Options -> Maybe FilePath -> Text -> IO ByteString
dhallToYaml Options{Bool
Maybe FilePath
Conversion
Value -> Value
preserveHeader :: Bool
noEdit :: Bool
output :: Maybe FilePath
file :: Maybe FilePath
conversion :: Conversion
quoted :: Bool
documents :: Bool
omission :: Value -> Value
explain :: Bool
preserveHeader :: Options -> Bool
noEdit :: Options -> Bool
output :: Options -> Maybe FilePath
file :: Options -> Maybe FilePath
conversion :: Options -> Conversion
quoted :: Options -> Bool
documents :: Options -> Bool
omission :: Options -> Value -> Value
explain :: Options -> Bool
..} Maybe FilePath
mFilePath Text
code = do
let explaining :: IO a -> IO a
explaining = if Bool
explain then forall a. IO a -> IO a
Dhall.detailed else forall a. a -> a
id
let adapt :: (a, Value) -> (a, Value)
adapt (a
header, Value
value) = (a
header, Value -> Value
omission Value
value)
(Header Text
comment, Value
json) <- forall {a}. (a, Value) -> (a, Value)
adapt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IO a -> IO a
explaining (Conversion
-> SpecialDoubleMode
-> Maybe FilePath
-> Text
-> IO (Header, Value)
Dhall.JSON.codeToHeaderAndValue Conversion
conversion SpecialDoubleMode
UseYAMLEncoding Maybe FilePath
mFilePath Text
code)
let suffix :: ByteString
suffix
| Bool
preserveHeader = Text -> ByteString
Data.Text.Encoding.encodeUtf8 Text
comment
| Bool
otherwise = forall a. Monoid a => a
mempty
let header :: ByteString
header =
if Bool
noEdit
then ByteString
generatedCodeNotice forall a. Semigroup a => a -> a -> a
<> ByteString
suffix
else ByteString
suffix
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString
header forall a. Semigroup a => a -> a -> a
<> Value -> Bool -> Bool -> ByteString
jsonToYaml Value
json Bool
documents Bool
quoted
jsonToYaml
:: Data.Aeson.Value
-> Bool
-> Bool
-> ByteString
jsonToYaml :: Value -> Bool -> Bool -> ByteString
jsonToYaml Value
json Bool
documents Bool
quoted =
ByteString -> ByteString
Data.ByteString.Lazy.toStrict forall a b. (a -> b) -> a -> b
$ case (Bool
documents, Value
json) of
(Bool
True, Data.Aeson.Array Array
elems)
-> (if Bool
quoted
then forall a. ToJSON a => [a] -> ByteString
Data.Aeson.Yaml.encodeQuotedDocuments
else forall a. ToJSON a => [a] -> ByteString
Data.Aeson.Yaml.encodeDocuments
) (forall a. Vector a -> [a]
Data.Vector.toList Array
elems)
(Bool
True, Value
value)
-> (if Bool
quoted
then forall a. ToJSON a => [a] -> ByteString
Data.Aeson.Yaml.encodeQuotedDocuments
else forall a. ToJSON a => [a] -> ByteString
Data.Aeson.Yaml.encodeDocuments
) [ Value
value ]
(Bool, Value)
_ -> (if Bool
quoted
then forall a. ToJSON a => a -> ByteString
Data.Aeson.Yaml.encodeQuoted
else forall a. ToJSON a => a -> ByteString
Data.Aeson.Yaml.encode
) Value
json