ehmry/dhall-haskell
ehmry
/
dhall-haskell
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

[POC] Add 'quoted' option (#941) 

Allow to generare quoted scalars if needed via providing a custom encode
options to Data.Yaml.encodeWith. So far two corner cases from yaml
itself (an empty scalar, and special strings) are omitted in the
implementation.
This commit is contained in:
Dmitry Dolgov 2019-05-12 16:44:12 +02:00 committed by Gabriel Gonzalez
parent bf4349ef7a
commit 07906673af
12 changed files with 165 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

55
appveyor.yml
View File

@ -12,7 +12,7 @@ environment:
# Override the temp directory to avoid sed escaping issues
# See https://github.com/haskell/cabal/issues/5386
TMP: c:\tmp
matrix:
# Commenting out for now default stack (lts-13) cause
# compilations times are reaching appveyor default build timeout
@ -35,21 +35,44 @@ cache:
- dhall-bash\.stack-work -> '%STACK_YAML%'
- dhall-lsp-server\.stack-work -> '%STACK_YAML%'
build_script:
- stack build
- stack install --local-bin-path bin
- if /I "%APPVEYOR_REPO_TAG%" EQU "true" (set DEPLOY_TAG=%APPVEYOR_REPO_TAG_NAME%) else (set DEPLOY_TAG=%APPVEYOR_REPO_COMMIT:~0,5%)
- set DEPLOY_SUFFIX=%DEPLOY_TAG%-x86_64-windows.zip
- 7z a "bin\dhall-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall.exe"
- 7z a "bin\dhall-json-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-json.exe"
- 7z a "bin\dhall-json-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-yaml.exe"
- 7z a "bin\dhall-json-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\json-to-dhall.exe"
- 7z a "bin\dhall-text-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-text.exe"
- 7z a "bin\dhall-bash-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-bash.exe"
# dhall-lsp-server can't be built with lts-6
- if exist "%APPVEYOR_BUILD_FOLDER%\bin\dhall-lsp-server.exe" ( 7z a "bin\dhall-lsp-server-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-lsp-server.exe" )
for:
-
matrix:
except:
# dhall-json is not supported for LTS 6
- STACK_YAML: stack-lts-6.yaml
build_script:
- stack build
- stack install --local-bin-path bin
- if /I "%APPVEYOR_REPO_TAG%" EQU "true" (set DEPLOY_TAG=%APPVEYOR_REPO_TAG_NAME%) else (set DEPLOY_TAG=%APPVEYOR_REPO_COMMIT:~0,5%)
- set DEPLOY_SUFFIX=%DEPLOY_TAG%-x86_64-windows.zip
- 7z a "bin\dhall-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall.exe"
- 7z a "bin\dhall-json-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-json.exe"
- 7z a "bin\dhall-json-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-yaml.exe"
- 7z a "bin\dhall-json-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\json-to-dhall.exe"
- 7z a "bin\dhall-text-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-text.exe"
- 7z a "bin\dhall-bash-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-bash.exe"
# dhall-lsp-server can't be built with lts-6
- if exist "%APPVEYOR_BUILD_FOLDER%\bin\dhall-lsp-server.exe" ( 7z a "bin\dhall-lsp-server-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-lsp-server.exe" )
-
matrix:
only:
- STACK_YAML: stack-lts-6.yaml
build_script:
- stack build
- stack install --local-bin-path bin
- if /I "%APPVEYOR_REPO_TAG%" EQU "true" (set DEPLOY_TAG=%APPVEYOR_REPO_TAG_NAME%) else (set DEPLOY_TAG=%APPVEYOR_REPO_COMMIT:~0,5%)
- set DEPLOY_SUFFIX=%DEPLOY_TAG%-x86_64-windows.zip
# dhall-json is not supported for LTS 6, so do not try to copy the
# corresponding binaries
- 7z a "bin\dhall-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall.exe"
- 7z a "bin\dhall-text-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-text.exe"
- 7z a "bin\dhall-bash-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-to-bash.exe"
# dhall-lsp-server can't be built with lts-6
- if exist "%APPVEYOR_BUILD_FOLDER%\bin\dhall-lsp-server.exe" ( 7z a "bin\dhall-lsp-server-%DEPLOY_SUFFIX%" "%APPVEYOR_BUILD_FOLDER%\bin\dhall-lsp-server.exe" )
-
matrix:
except:
@ -74,7 +97,7 @@ artifacts:
name: dhall-bash
- path: bin\dhall-lsp-server-%DEPLOY_SUFFIX%
name: dhall-lsp-server
deploy:
- provider: GitHub
auth_token:

7
dhall-json/dhall-json.cabal
View File

@ -35,10 +35,13 @@ Library
Build-Depends:
base >= 4.8.0.0 && < 5 ,
aeson >= 1.0.0.0 && < 1.5 ,
bytestring < 0.11,
dhall >= 1.22.0 && < 1.24,
optparse-applicative >= 0.14.0.0 && < 0.15,
text >= 0.11.1.0 && < 1.3 ,
unordered-containers < 0.3
unordered-containers < 0.3 ,
vector ,
yaml >= 0.5.0 && < 0.12
Exposed-Modules: Dhall.JSON
GHC-Options: -Wall
@ -68,8 +71,6 @@ Executable dhall-to-yaml
dhall ,
dhall-json ,
optparse-applicative ,
yaml >= 0.5.0 && < 0.12,
vector ,
text
GHC-Options: -Wall

17
dhall-json/dhall-to-yaml/Main.hs
View File

@ -12,8 +12,6 @@ import Options.Applicative (Parser, ParserInfo)
import qualified Control.Exception
import qualified Data.ByteString
import qualified Data.Text.IO
import qualified Data.Vector
import qualified Data.Yaml
import qualified Dhall
import qualified Dhall.JSON
import qualified GHC.IO.Encoding
@ -25,6 +23,7 @@ data Options = Options
{ explain :: Bool
, omission :: Value -> Value
, documents :: Bool
, quoted :: Bool
, conversion :: Conversion
}
@ -34,6 +33,7 @@ parseOptions =
<$> parseExplain
<*> Dhall.JSON.parseOmission
<*> parseDocuments
<*> parseQuoted
<*> Dhall.JSON.parseConversion
where
parseExplain =
@ -48,6 +48,12 @@ parseOptions =
<> Options.Applicative.help "If given a Dhall list, output a document for every element"
)
parseQuoted =
Options.Applicative.switch
( Options.Applicative.long "quoted"
<> Options.Applicative.help "Prevent from generating not quoted scalars"
)
parserInfo :: ParserInfo Options
parserInfo =
Options.Applicative.info
@ -69,12 +75,7 @@ main = do
json <- omission <$> explaining (Dhall.JSON.codeToValue conversion "(stdin)" stdin)
let yaml = case (documents, json) of
(True, Data.Yaml.Array elems)
-> Data.ByteString.intercalate "\n---\n"
$ fmap Data.Yaml.encode
$ Data.Vector.toList elems
_ -> Data.Yaml.encode json
let yaml = Dhall.JSON.jsonToYaml json documents quoted
Data.ByteString.putStr yaml

36
dhall-json/src/Dhall/JSON.hs
View File

@ -166,6 +166,7 @@ module Dhall.JSON (
, convertToHomogeneousMaps
, parseConversion
, codeToValue
, jsonToYaml
-- * Exceptions
, CompileError(..)
@ -182,17 +183,21 @@ import Dhall.TypeCheck (X)
import Dhall.Map (Map)
import Options.Applicative (Parser)
import qualified Data.ByteString
import qualified Data.Foldable
import qualified Data.HashMap.Strict
import qualified Data.List
import qualified Data.Ord
import qualified Data.Text
import qualified Data.Vector
import qualified Data.Yaml
import qualified Dhall.Core
import qualified Dhall.Import
import qualified Dhall.Map
import qualified Dhall.Parser
import qualified Dhall.TypeCheck
import qualified Options.Applicative
import qualified Text.Libyaml
{-| This is the exception type for errors that might arise when translating
Dhall to JSON
@ -821,3 +826,34 @@ codeToValue conversion name code = do
case dhallToJSON convertedExpression of
Left err -> Control.Exception.throwIO err
Right json -> return json
-- | Transform json representation into yaml
jsonToYaml
:: Value
-> Bool
-> Bool
-> Data.ByteString.ByteString
jsonToYaml json documents quoted = case (documents, json) of
(True, Data.Yaml.Array elems)
-> Data.ByteString.intercalate "\n---\n"
$ fmap (encodeYaml encodeOptions)
$ Data.Vector.toList elems
_ -> encodeYaml encodeOptions json
where
encodeYaml = Data.Yaml.encodeWith
customStyle = \s -> case () of
()
| "\n" `Data.Text.isInfixOf` s -> ( noTag, literal )
| otherwise -> ( noTag, Text.Libyaml.SingleQuoted )
where
noTag = Text.Libyaml.NoTag
literal = Text.Libyaml.Literal
quotedOptions = Data.Yaml.setStringStyle
customStyle
Data.Yaml.defaultEncodeOptions
encodeOptions = if quoted
then quotedOptions
else Data.Yaml.defaultEncodeOptions

58
dhall-json/tasty/Main.hs
View File

@ -23,6 +23,8 @@ testTree :: TestTree
testTree =
Test.Tasty.testGroup "dhall-json"
[ issue48
, yamlQuotedStrings
, yaml
]
issue48 :: TestTree
@ -60,3 +62,59 @@ issue48 = Test.Tasty.HUnit.testCase "Issue #48" assertion
"Conversion to homogeneous maps did not generate the expected JSON output"
Test.Tasty.HUnit.assertEqual message expectedValue actualValue
yamlQuotedStrings :: TestTree
yamlQuotedStrings = Test.Tasty.HUnit.testCase "Yaml: quoted string style" assertion
where
assertion = do
let file = "./tasty/data/yaml.dhall"
code <- Data.Text.IO.readFile file
parsedExpression <- case Dhall.Parser.exprFromText file code of
Left exception -> Control.Exception.throwIO exception
Right parsedExpression -> return parsedExpression
resolvedExpression <- Dhall.Import.load parsedExpression
jsonValue <- case Dhall.JSON.dhallToJSON resolvedExpression of
Left exception -> Control.Exception.throwIO exception
Right jsonValue -> return jsonValue
let actualValue = Dhall.JSON.jsonToYaml jsonValue False True
bytes <- Data.ByteString.Lazy.readFile "./tasty/data/quoted.yaml"
let expectedValue = Data.ByteString.Lazy.toStrict bytes
let message =
"Conversion to quoted yaml did not generate the expected output"
Test.Tasty.HUnit.assertEqual message expectedValue actualValue
yaml :: TestTree
yaml = Test.Tasty.HUnit.testCase "Yaml: normal string style" assertion
where
assertion = do
let file = "./tasty/data/yaml.dhall"
code <- Data.Text.IO.readFile file
parsedExpression <- case Dhall.Parser.exprFromText file code of
Left exception -> Control.Exception.throwIO exception
Right parsedExpression -> return parsedExpression
resolvedExpression <- Dhall.Import.load parsedExpression
jsonValue <- case Dhall.JSON.dhallToJSON resolvedExpression of
Left exception -> Control.Exception.throwIO exception
Right jsonValue -> return jsonValue
let actualValue = Dhall.JSON.jsonToYaml jsonValue False False
bytes <- Data.ByteString.Lazy.readFile "./tasty/data/normal.yaml"
let expectedValue = Data.ByteString.Lazy.toStrict bytes
let message =
"Conversion to normal yaml did not generate the expected output"
Test.Tasty.HUnit.assertEqual message expectedValue actualValue

5
dhall-json/tasty/data/normal.yaml Normal file
View File

@ -0,0 +1,5 @@
bool_value: true
text: |
Plain text
string_value: 2000-01-01
int_value: 1

5
dhall-json/tasty/data/quoted.yaml Normal file
View File

@ -0,0 +1,5 @@
'bool_value': true
'text': |
Plain text
'string_value': '2000-01-01'
'int_value': 1

5
dhall-json/tasty/data/yaml.dhall Normal file
View File

@ -0,0 +1,5 @@
{ string_value = "2000-01-01"
, text = ./tasty/data/yaml.txt as Text
, int_value = 1
, bool_value = True
}

1
dhall-json/tasty/data/yaml.txt Normal file
View File

@ -0,0 +1 @@
Plain text

1
stack-lts-12.yaml
View File

@ -17,6 +17,7 @@ extra-deps:
- haskell-lsp-types-0.8.0.1
- turtle-1.5.14
- transformers-compat-0.6.4
- yaml-0.10.4.0
flags:
transformers-compat:
five-three: true

2
stack-lts-6.yaml
View File

@ -2,7 +2,6 @@ resolver: lts-6.27
packages:
- dhall
- dhall-bash
- dhall-json
- dhall-text
extra-deps:
- ansi-terminal-0.7.1.1
@ -38,6 +37,7 @@ extra-deps:
- resourcet-1.1.11
- turtle-1.5.14
- unliftio-core-0.1.2.0
- yaml-0.10.4.0
flags:
transformers-compat:
four: true

1
stack.yaml
View File

@ -7,6 +7,7 @@ packages:
- dhall-lsp-server
extra-deps:
- repline-0.2.1.0
- yaml-0.10.4.0
nix:
packages:
- ncurses