Fix dhall-to-yaml
to quote special strings (#1474)
Fixes https://github.com/dhall-lang/dhall-haskell/issues/1472 This also refactors the code to a form that was easier for me to understand
This commit is contained in:
parent
90315e9eda
commit
8e7586b247
|
@ -98,35 +98,16 @@ jsonToYaml json documents quoted =
|
||||||
$ fmap (Data.ByteString.Lazy.toStrict. (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8). (:[]))
|
$ fmap (Data.ByteString.Lazy.toStrict. (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8). (:[]))
|
||||||
$ Data.Vector.toList elems
|
$ Data.Vector.toList elems
|
||||||
_ -> Data.ByteString.Lazy.toStrict (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8 [json])
|
_ -> Data.ByteString.Lazy.toStrict (Data.YAML.Aeson.encodeValue' schemaEncoder YT.UTF8 [json])
|
||||||
|
|
||||||
where
|
where
|
||||||
defaultSchemaEncoder = YS.setScalarStyle style Y.coreSchemaEncoder
|
style (Y.SStr s)
|
||||||
|
| "\n" `Text.isInfixOf` s =
|
||||||
|
Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
|
||||||
|
| quoted =
|
||||||
|
Right (YE.untagged, YE.SingleQuoted, s)
|
||||||
|
style s =
|
||||||
|
YS.schemaEncoderScalar Y.coreSchemaEncoder s
|
||||||
|
|
||||||
defaultEncodeStr s = case () of
|
schemaEncoder = YS.setScalarStyle style Y.coreSchemaEncoder
|
||||||
()
|
|
||||||
| "\n" `Text.isInfixOf` s -> Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
|
|
||||||
| YS.isAmbiguous Y.coreSchemaResolver s -> Right (YE.untagged, YE.SingleQuoted, s)
|
|
||||||
| otherwise -> Right (YE.untagged, YE.Plain, s)
|
|
||||||
|
|
||||||
style s = case s of
|
|
||||||
Y.SNull -> Right (YE.untagged, YE.Plain, "null")
|
|
||||||
Y.SBool bool -> Right (YE.untagged, YE.Plain, YS.encodeBool bool)
|
|
||||||
Y.SFloat double -> Right (YE.untagged, YE.Plain, YS.encodeDouble double)
|
|
||||||
Y.SInt int -> Right (YE.untagged, YE.Plain, YS.encodeInt int)
|
|
||||||
Y.SStr text -> defaultEncodeStr text
|
|
||||||
Y.SUnknown t v -> Right (t, YE.SingleQuoted, v)
|
|
||||||
|
|
||||||
customStyle (Y.SStr s) = case () of
|
|
||||||
()
|
|
||||||
| "\n" `Text.isInfixOf` s -> Right (YE.untagged, YE.Literal YE.Clip YE.IndentAuto, s)
|
|
||||||
| otherwise -> Right (YE.untagged, YE.SingleQuoted, s)
|
|
||||||
customStyle scalar = (YS.schemaEncoderScalar defaultSchemaEncoder) scalar
|
|
||||||
|
|
||||||
customSchemaEncoder = YS.setScalarStyle customStyle defaultSchemaEncoder
|
|
||||||
|
|
||||||
schemaEncoder = if quoted
|
|
||||||
then customSchemaEncoder
|
|
||||||
else defaultSchemaEncoder
|
|
||||||
#else
|
#else
|
||||||
Data.ByteString.Lazy.toStrict $ case (documents, json) of
|
Data.ByteString.Lazy.toStrict $ case (documents, json) of
|
||||||
(True, Data.Aeson.Array elems)
|
(True, Data.Aeson.Array elems)
|
||||||
|
|
|
@ -36,6 +36,9 @@ testTree =
|
||||||
, testDhallToYaml
|
, testDhallToYaml
|
||||||
Dhall.Yaml.defaultOptions
|
Dhall.Yaml.defaultOptions
|
||||||
"./tasty/data/normal"
|
"./tasty/data/normal"
|
||||||
|
, testDhallToYaml
|
||||||
|
Dhall.Yaml.defaultOptions
|
||||||
|
"./tasty/data/special"
|
||||||
, testDhallToYaml
|
, testDhallToYaml
|
||||||
(Dhall.Yaml.defaultOptions { Dhall.Yaml.quoted = True })
|
(Dhall.Yaml.defaultOptions { Dhall.Yaml.quoted = True })
|
||||||
"./tasty/data/quoted"
|
"./tasty/data/quoted"
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
bool_value: true
|
bool_value: true
|
||||||
int_value: 1
|
int_value: 1
|
||||||
string_value: 2000-01-01
|
string_value: "2000-01-01"
|
||||||
text: |
|
text: |
|
||||||
Plain text
|
Plain text
|
||||||
yes: y
|
yes: y
|
||||||
|
|
1
dhall-json/tasty/data/special.dhall
Normal file
1
dhall-json/tasty/data/special.dhall
Normal file
|
@ -0,0 +1 @@
|
||||||
|
{ foo = "*" }
|
1
dhall-json/tasty/data/special.yaml
Normal file
1
dhall-json/tasty/data/special.yaml
Normal file
|
@ -0,0 +1 @@
|
||||||
|
foo: "*"
|
Loading…
Reference in New Issue
Block a user