From 07906673afbb7a4f606862ded2a02f1b7826124b Mon Sep 17 00:00:00 2001 From: Dmitry Dolgov <9erthalion6@gmail.com> Date: Sun, 12 May 2019 16:44:12 +0200 Subject: [PATCH] [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. --- appveyor.yml | 55 ++++++++++++++++++++--------- dhall-json/dhall-json.cabal | 7 ++-- dhall-json/dhall-to-yaml/Main.hs | 17 ++++----- dhall-json/src/Dhall/JSON.hs | 36 +++++++++++++++++++ dhall-json/tasty/Main.hs | 58 +++++++++++++++++++++++++++++++ dhall-json/tasty/data/normal.yaml | 5 +++ dhall-json/tasty/data/quoted.yaml | 5 +++ dhall-json/tasty/data/yaml.dhall | 5 +++ dhall-json/tasty/data/yaml.txt | 1 + stack-lts-12.yaml | 1 + stack-lts-6.yaml | 2 +- stack.yaml | 1 + 12 files changed, 165 insertions(+), 28 deletions(-) create mode 100644 dhall-json/tasty/data/normal.yaml create mode 100644 dhall-json/tasty/data/quoted.yaml create mode 100644 dhall-json/tasty/data/yaml.dhall create mode 100644 dhall-json/tasty/data/yaml.txt diff --git a/appveyor.yml b/appveyor.yml index 9d65686..59fb0ab 100644 --- a/appveyor.yml +++ b/appveyor.yml @@ -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: diff --git a/dhall-json/dhall-json.cabal b/dhall-json/dhall-json.cabal index e0aeb85..2553f3a 100644 --- a/dhall-json/dhall-json.cabal +++ b/dhall-json/dhall-json.cabal @@ -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 diff --git a/dhall-json/dhall-to-yaml/Main.hs b/dhall-json/dhall-to-yaml/Main.hs index fd516df..6ca5f6f 100644 --- a/dhall-json/dhall-to-yaml/Main.hs +++ b/dhall-json/dhall-to-yaml/Main.hs @@ -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 diff --git a/dhall-json/src/Dhall/JSON.hs b/dhall-json/src/Dhall/JSON.hs index 2765a20..5cfbf6f 100644 --- a/dhall-json/src/Dhall/JSON.hs +++ b/dhall-json/src/Dhall/JSON.hs @@ -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 diff --git a/dhall-json/tasty/Main.hs b/dhall-json/tasty/Main.hs index cd2fb78..70be8da 100644 --- a/dhall-json/tasty/Main.hs +++ b/dhall-json/tasty/Main.hs @@ -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 diff --git a/dhall-json/tasty/data/normal.yaml b/dhall-json/tasty/data/normal.yaml new file mode 100644 index 0000000..785dfc5 --- /dev/null +++ b/dhall-json/tasty/data/normal.yaml @@ -0,0 +1,5 @@ +bool_value: true +text: | + Plain text +string_value: 2000-01-01 +int_value: 1 diff --git a/dhall-json/tasty/data/quoted.yaml b/dhall-json/tasty/data/quoted.yaml new file mode 100644 index 0000000..16ee2a8 --- /dev/null +++ b/dhall-json/tasty/data/quoted.yaml @@ -0,0 +1,5 @@ +'bool_value': true +'text': | + Plain text +'string_value': '2000-01-01' +'int_value': 1 diff --git a/dhall-json/tasty/data/yaml.dhall b/dhall-json/tasty/data/yaml.dhall new file mode 100644 index 0000000..1eeedf7 --- /dev/null +++ b/dhall-json/tasty/data/yaml.dhall @@ -0,0 +1,5 @@ +{ string_value = "2000-01-01" +, text = ./tasty/data/yaml.txt as Text +, int_value = 1 +, bool_value = True +} diff --git a/dhall-json/tasty/data/yaml.txt b/dhall-json/tasty/data/yaml.txt new file mode 100644 index 0000000..ec6816d --- /dev/null +++ b/dhall-json/tasty/data/yaml.txt @@ -0,0 +1 @@ +Plain text diff --git a/stack-lts-12.yaml b/stack-lts-12.yaml index 2cdaf01..1bc4c0e 100644 --- a/stack-lts-12.yaml +++ b/stack-lts-12.yaml @@ -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 diff --git a/stack-lts-6.yaml b/stack-lts-6.yaml index f733722..b3378ea 100644 --- a/stack-lts-6.yaml +++ b/stack-lts-6.yaml @@ -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 diff --git a/stack.yaml b/stack.yaml index 18d0dc0..3bb32d5 100644 --- a/stack.yaml +++ b/stack.yaml @@ -7,6 +7,7 @@ packages: - dhall-lsp-server extra-deps: - repline-0.2.1.0 + - yaml-0.10.4.0 nix: packages: - ncurses