Eta support for dhall-json (#1013)

After #989 and #993 the use of the `yaml` package is isolated in the lib modules `Dhall.Yaml` and `Dhall.YamlToDhall` so it is easier to add support for compilers that cant use the `yaml`package like eta or ghcjs.

With this one we would add support for [eta](https://eta-lang.org/), a fork of ghc that compiles to jvm bytecode.

Main changes:

* Add conditional to cabal file and cpp conditions to the main modules for yaml to use a specific module for eta, `Dhall.Yaml.Eta` that replaces calls to the `yaml`package to ffi calls to the java lib [jackson](https://github.com/FasterXML/jackson), one of the most popular ones in the java world.
* Add the java files that contains the ffi calls
* Mark  `buildable: False` the subpackages that cant be built by eta for now

One effect of use the cabal file for cabal and etlas (the build tool for eta) is stack and cabal builds show those warnings:

```
Warning: Cabal file warning in D:\ws\eta\dhall\dhall-haskell\dhall-json\dhall-js
on.cabal@ 69:9:
         Unknown field: "maven-depends"

Warning: Cabal file warning in D:\ws\eta\dhall\dhall-haskell\dhall-json\dhall-js
on.cabal@ 74:9:
         Unknown field: "java-sources"
```

I've not found a way to avoid them other than use another file for etlas build (`etlas.dhall`). It would suppose duplicate most of the logic, though.

dhall-json/dhall-json.cabal

@@ -24,11 +24,13 @@ Description:
 Category: Compiler
 Extra-Source-Files:
     CHANGELOG.md
+    java/*.java
     tasty/data/*.dhall
     tasty/data/*.json
     tasty/data/*.txt
     tasty/data/*.yaml
 
+
 Source-Repository head
     Type: git
     Location: https://github.com/dhall-lang/dhall-haskell/tree/master/dhall-json
@@ -61,10 +63,20 @@ Library
 
         
     GHC-Options: -Wall
-    if flag(yaml-pre-0_11)
+    if impl(eta)
+        Build-Depends:
+            utf8-string >= 1.0 && <= 1.1
+        Maven-Depends:
+          com.fasterxml.jackson.core:jackson-core:2.9.6,
+          com.fasterxml.jackson.core:jackson-databind:2.9.6,
+          com.fasterxml.jackson.dataformat:jackson-dataformat-yaml:2.9.6
+        Other-Modules: Dhall.Yaml.Eta
+        Java-Sources: java/Utils.java
+    else
+      if flag(yaml-pre-0_11)
         Build-Depends:
             yaml >= 0.5.0 && < 0.11
-    else
+      else
         Build-Depends:
             libyaml >= 0.1.1.0 && < 0.2 ,
             yaml    >= 0.11.0  && < 0.12

dhall-json/dhall-to-yaml/Main.hs

@@ -1,6 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards   #-}
-
 module Main where
 
 import Control.Exception (SomeException)

dhall-json/java/Utils.java

@@ -0,0 +1,23 @@
+import java.io.IOException;
+
+import com.fasterxml.jackson.core.JsonProcessingException;
+import com.fasterxml.jackson.databind.JsonNode;
+import com.fasterxml.jackson.databind.ObjectMapper;
+import com.fasterxml.jackson.dataformat.yaml.YAMLMapper;
+
+public class Utils {
+
+    public static String jsonToYaml (String jsonString) throws
+        JsonProcessingException, IOException {
+        JsonNode jsonNodeTree = new ObjectMapper().readTree(jsonString);
+        String jsonAsYaml = new YAMLMapper().writeValueAsString(jsonNodeTree);
+        return jsonAsYaml;
+    }
+
+     public static String yamlToJson (String yamlString) throws
+        JsonProcessingException, IOException {
+        JsonNode jsonNodeTree = new YAMLMapper().readTree(yamlString);
+        String yamlAsJson = new ObjectMapper().writeValueAsString(jsonNodeTree);
+        return yamlAsJson;
+    }
+}

dhall-json/src/Dhall/Yaml.hs

@@ -12,20 +12,25 @@ module Dhall.Yaml
 import Data.ByteString (ByteString)
 import Data.Monoid ((<>))
 import Data.Text (Text)
-import Dhall.JSON (Conversion(..), SpecialDoubleMode(..),codeToValue)
+import Dhall.JSON (Conversion(..), SpecialDoubleMode(..), codeToValue)
 import Options.Applicative (Parser)
 
 import qualified Data.Aeson
 import qualified Data.ByteString
 import qualified Data.Vector
-import qualified Data.Yaml
 import qualified Dhall
 import qualified Options.Applicative
-#if MIN_VERSION_yaml(0,10,2)
+#if defined(ETA_VERSION)
+import Dhall.Yaml.Eta ( jsonToYaml )
+#else
+import qualified Data.Yaml
+# if MIN_VERSION_yaml(0,10,2)
 import qualified Data.Text
 import qualified Text.Libyaml
+# endif
 #endif
 
+
 data Options = Options
     { explain    :: Bool
     , omission   :: Data.Aeson.Value -> Data.Aeson.Value
@@ -72,22 +77,26 @@ dhallToYaml Options{..} name code = do
 
   return $ jsonToYaml json documents quoted
 
+#if !defined(ETA_VERSION)
 -- | Transform json representation into yaml
 jsonToYaml
     :: Data.Aeson.Value
     -> Bool
     -> Bool
     -> 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
+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
-#if !MIN_VERSION_yaml(0,10,2)
+# if !MIN_VERSION_yaml(0,10,2)
     encodeYaml = Data.Yaml.encode
-#else
+# else
     encodeYaml = Data.Yaml.encodeWith
 
     customStyle = \s -> case () of
@@ -105,4 +114,5 @@ jsonToYaml json documents quoted = case (documents, json) of
     encodeOptions = if quoted
         then quotedOptions
         else Data.Yaml.defaultEncodeOptions
+# endif
 #endif

dhall-json/src/Dhall/Yaml/Eta.hs

@@ -0,0 +1,60 @@
+{-# LANGUAGE OverloadedStrings        #-}
+{-# LANGUAGE ForeignFunctionInterface #-}
+
+module Dhall.Yaml.Eta ( jsonToYaml, showYaml, yamlToJson ) where
+
+import Data.Bifunctor (bimap)
+import Control.Exception (try)
+import Data.ByteString (ByteString)
+import Java
+import Java.Exception
+import System.IO.Unsafe (unsafePerformIO)
+
+import qualified Data.Aeson
+import qualified Data.ByteString
+import qualified Data.ByteString.Lazy
+import qualified Data.ByteString.UTF8
+import qualified Data.Vector
+
+
+foreign import java unsafe "@static Utils.jsonToYaml" javaJsonToYaml
+  :: String -> String
+
+jsonToYaml :: Data.Aeson.Value -> Bool -> Bool -> ByteString
+jsonToYaml json documents _quoted =
+
+  case (documents, json) of
+    (True,  Data.Aeson.Array elems)
+      -> Data.ByteString.intercalate "\n---\n"
+         $ fmap aesonToYaml
+         $ Data.Vector.toList elems
+    _ -> aesonToYaml json
+
+  where aesonToYaml =
+           Data.ByteString.UTF8.fromString 
+         . javaJsonToYaml
+         . Data.ByteString.UTF8.toString
+         . Data.ByteString.Lazy.toStrict
+         . Data.Aeson.encode
+
+foreign import java unsafe "@static Utils.yamlToJson" javaYamlToJson
+  :: String -> IO String
+
+yamlToJson :: ByteString -> Either String Data.Aeson.Value
+yamlToJson =   (>>= Data.Aeson.eitherDecode)
+             . bimap getExceptionMessage
+                     (  Data.ByteString.Lazy.fromStrict
+                      . Data.ByteString.UTF8.fromString)
+             . javaTryYamlToJson
+             . Data.ByteString.UTF8.toString
+
+  where javaTryYamlToJson :: String -> Either JException String
+        javaTryYamlToJson = unsafePerformIO . try . javaYamlToJson
+
+        getExceptionMessage :: JException -> String
+        getExceptionMessage ex =
+          unsafePerformJava $ ex <.> getLocalizedMessage
+
+showYaml :: Data.Aeson.Value -> String
+showYaml value =
+  Data.ByteString.UTF8.toString (jsonToYaml value False False)

dhall-json/src/Dhall/YamlToDhall.hs

@@ -1,4 +1,5 @@
-{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE CPP             #-}
+{-# LANGUAGE RecordWildCards #-}
 
 module Dhall.YamlToDhall
   ( Options(..)
@@ -7,8 +8,7 @@ module Dhall.YamlToDhall
   , dhallFromYaml
   ) where
 
-import Data.Bifunctor (bimap)
-import Data.ByteString.Lazy (ByteString, toStrict)
+import Data.ByteString (ByteString)
 
 import Dhall.JSONToDhall
   ( CompileError(..)
@@ -21,12 +21,18 @@ import Dhall.JSONToDhall
   )
 
 import Control.Exception (Exception, throwIO)
-import Data.Aeson (Value)
 import Data.Text (Text)
 
+import qualified Dhall.Core as Dhall
+
+#if defined(ETA_VERSION)
+import Dhall.Yaml.Eta ( yamlToJson, showYaml )
+#else
+import Data.Aeson (Value)
+import Data.Bifunctor (bimap)
 import qualified Data.ByteString.Char8 as BS8
 import qualified Data.Yaml
-import qualified Dhall.Core as Dhall
+#endif
 
 -- | Options to parametrize conversion
 data Options = Options
@@ -47,10 +53,6 @@ instance Show YAMLCompileError where
 instance Exception YAMLCompileError
 
 
-showYaml :: Value -> String
-showYaml value = BS8.unpack (Data.Yaml.encode value)
-
-
 -- | Transform yaml representation into dhall
 dhallFromYaml :: Options -> ByteString -> IO Text
 dhallFromYaml Options{..} yaml = do
@@ -63,6 +65,13 @@ dhallFromYaml Options{..} yaml = do
 
   either (throwIO . YAMLCompileError) (pure . Dhall.pretty) dhall
 
+
+#if !defined(ETA_VERSION)
 yamlToJson :: ByteString -> Either String Data.Aeson.Value
-yamlToJson  =
-  bimap Data.Yaml.prettyPrintParseException id . Data.Yaml.decodeEither' . toStrict
+yamlToJson =
+  bimap Data.Yaml.prettyPrintParseException id . Data.Yaml.decodeEither'
+
+showYaml :: Value -> String
+showYaml value = BS8.unpack (Data.Yaml.encode value)
+#endif
+

dhall-json/yaml-to-dhall/Main.hs

@@ -11,7 +11,7 @@ module Main where
 import qualified Control.Exception
 import           Control.Exception (SomeException)
 import           Control.Monad (when)
-import qualified Data.ByteString.Lazy.Char8 as BSL8
+import qualified Data.ByteString.Char8 as BSL8
 import           Data.Monoid ((<>))
 import           Data.Text (Text)
 import qualified Data.Text.IO as Text

dhall-lsp-server/dhall-lsp-server.cabal

@@ -65,6 +65,9 @@ library
     , yi-rope
   default-language: Haskell2010
   GHC-Options: -Wall -fwarn-incomplete-uni-patterns
+  if impl(eta)
+     buildable: False
+
 
 executable dhall-lsp-server
   main-is: Main.hs
@@ -98,6 +101,8 @@ executable dhall-lsp-server
     , yi-rope
   default-language: Haskell2010
   GHC-Options: -Wall -fwarn-incomplete-uni-patterns
+  if impl(eta)
+     buildable: False
 
 test-suite dhall-lsp-server-test
   type: exitcode-stdio-1.0
@@ -139,3 +144,5 @@ test-suite dhall-lsp-server-test
     , unordered-containers
     , yi-rope
   default-language: Haskell2010
+  if impl(eta)
+     buildable: False

dhall/tests/Dhall/Test/Dhall.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass      #-}
 {-# LANGUAGE DeriveGeneric       #-}
+{-# LANGUAGE FlexibleContexts    #-}
 {-# LANGUAGE OverloadedStrings   #-}
 {-# LANGUAGE RecordWildCards     #-}
 {-# LANGUAGE ScopedTypeVariables #-}

dhall/tests/Dhall/Test/Regression.hs

@@ -1,5 +1,6 @@
 {-# LANGUAGE DeriveAnyClass    #-}
 {-# LANGUAGE DeriveGeneric     #-}
+{-# LANGUAGE FlexibleContexts  #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Dhall.Test.Regression where