Bladeren bron

Update wizzardo-inline after Debian Stretch EOL (#8223)

* Update wizzardo-inline benchmark

* Turn ghc optimizations on

* Invoke wizzardo-inline binary directly
Facundo Domínguez 2 jaren geleden
bovenliggende
commit
f9adc81806

+ 4 - 0
frameworks/Haskell/wizzardo-inline/.bazelrc

@@ -0,0 +1,4 @@
+build --host_javabase=@local_jdk//:jdk
+build --host_platform=@io_tweag_rules_nixpkgs//nixpkgs/platforms:host
+build --compilation_mode opt
+run --compilation_mode opt

+ 1 - 0
frameworks/Haskell/wizzardo-inline/BUILD.bazel

@@ -0,0 +1 @@
+exports_files(["nixpkgs.nix"])

+ 259 - 0
frameworks/Haskell/wizzardo-inline/WORKSPACE

@@ -0,0 +1,259 @@
+workspace(name = "io_tweag_inline_java")
+
+load("@bazel_tools//tools/build_defs/repo:http.bzl", "http_archive")
+
+http_archive(
+    name = "rules_haskell",
+    sha256 = "2b36e26fde296dc9fbaeed087c898fdce23af0247592e897c317d19345b0e259",
+    strip_prefix = "rules_haskell-7a7f8545789dc4f3bc0780d5725e1337bb494ea6",
+    urls = ["https://github.com/tweag/rules_haskell/archive/7a7f8545789dc4f3bc0780d5725e1337bb494ea6.zip"],
+)
+
+load("@rules_haskell//haskell:repositories.bzl", "rules_haskell_dependencies")
+rules_haskell_dependencies()
+
+load(
+    "@io_tweag_rules_nixpkgs//nixpkgs:nixpkgs.bzl",
+    "nixpkgs_local_repository",
+    "nixpkgs_package",
+    "nixpkgs_python_configure",
+)
+
+nixpkgs_local_repository(
+    name = "nixpkgs",
+    nix_file = "//:nixpkgs.nix",
+)
+
+nixpkgs_python_configure(repository = "@nixpkgs")
+
+nixpkgs_package(
+    name = "alex",
+    attribute_path = "haskellPackages.alex",
+    repository = "@nixpkgs",
+)
+
+#nixpkgs_package(
+#    name = "stack_ignore_global_hints",
+#    attribute_path = "stack_ignore_global_hints",
+#    repository = "@nixpkgs",
+#)
+#
+#load("//:config_settings/setup.bzl", "config_settings")
+#config_settings(name = "config_settings")
+#load("@config_settings//:info.bzl", "ghc_version")
+
+load("@rules_haskell//haskell:cabal.bzl", "stack_snapshot")
+
+stack_snapshot(
+    name = "stackage",
+    packages = [
+        "Cabal",
+        "aeson",
+        "async",
+        "base",
+        "bytestring",
+        "choice",
+        "constraints",
+        "containers",
+        "criterion",
+        "deepseq",
+        "directory",
+        "distributed-closure",
+        "exceptions",
+        "filemanip",
+        "filepath",
+        "ghc",
+        "hspec",
+        "inline-c",
+        "language-java",
+        "monad-logger",
+        "mtl",
+        "process",
+        "QuickCheck",
+        "quickcheck-text",
+        "quickcheck-unicode",
+        "split",
+        "streaming",
+        "template-haskell",
+        "temporary",
+        "text",
+        "time",
+        "vector",
+        "unix",
+        # dependencies of th-desugar
+        "fail",
+        "ghc-prim",
+        "linear-base",
+        "ordered-containers",
+        "semigroups",
+        "singletons",
+        "singletons-base",
+        "stm",
+        "syb",
+        "th-abstraction",
+        "th-lift",
+        "th-orphans",
+        "transformers-compat",
+        # dependencies of singletons
+        "ghc-boot-th",
+        "pretty",
+        "transformers",
+    ],
+    extra_deps = { "zlib" : ["@zlib.dev//:zlib"] },
+    components_dependencies = {
+        "attoparsec": """{"lib:attoparsec": ["lib:attoparsec-internal"]}""",
+    },
+    components =
+        {
+            "attoparsec": [
+                "lib",
+                "lib:attoparsec-internal",
+            ],
+        },
+    local_snapshot = "//:snapshot-9.0.2.yaml",
+    # stack = "@stack_ignore_global_hints//:bin/stack" if ghc_version == "9.0.1" else None,
+)
+
+load("@rules_haskell//haskell:nixpkgs.bzl", "haskell_register_ghc_nixpkgs")
+
+nixpkgs_package(
+    name = "glibc_locales",
+    attribute_path = "glibcLocales",
+    build_file_content = """
+package(default_visibility = ["//visibility:public"])
+
+filegroup(
+    name = "locale-archive",
+    srcs = ["lib/locale/locale-archive"],
+)
+""",
+    repository = "@nixpkgs",
+)
+
+haskell_register_ghc_nixpkgs(
+    attribute_path = "haskell.compiler.ghc902",
+    locale_archive = "@glibc_locales//:locale-archive",
+    repositories = {"nixpkgs": "@nixpkgs"},
+    version = "9.0.2",
+    compiler_flags = [
+        "-Werror",
+        "-Wall",
+        "-Wcompat",
+        "-Wincomplete-record-updates",
+        "-Wredundant-constraints",
+    ],
+)
+
+nixpkgs_package(
+    name = "sed",
+    attribute_path = "gnused",
+    repository = "@nixpkgs",
+)
+
+nixpkgs_package(
+    name = "hspec-discover",
+    attribute_path = "haskellPackages.hspec-discover",
+    repository = "@nixpkgs",
+)
+
+nixpkgs_package(
+    name = "nixpkgs_zlib",
+    attribute_path = "zlib",
+    repository = "@nixpkgs",
+)
+
+nixpkgs_package(
+    name = "zlib.dev",
+    repository = "@nixpkgs",
+    build_file_content = """
+load("@rules_cc//cc:defs.bzl", "cc_library")
+filegroup(
+    name = "include",
+    srcs = glob(["include/*.h"]),
+    visibility = ["//visibility:public"],
+)
+cc_library(
+    name = "zlib",
+    srcs = ["@nixpkgs_zlib//:lib"],
+    hdrs = [":include"],
+    linkstatic = 1,
+    strip_include_prefix = "include",
+    visibility = ["//visibility:public"],
+)
+""",
+)
+
+nixpkgs_package(
+    name = "openjdk",
+    attribute_path = "openjdk11",
+    repository = "@nixpkgs",
+    build_file_content = """
+filegroup(
+    name = "bin",
+    srcs = ["bin/javac"],
+    visibility = ["//visibility:public"],
+)
+
+filegroup(
+    name = "libjvm",
+    srcs = select(
+      { "@bazel_tools//src/conditions:darwin": ["lib/server/libjvm.dylib"],
+        "@bazel_tools//src/conditions:linux_x86_64": ["lib/openjdk/lib/server/libjvm.so"],
+      }),
+    visibility = ["//visibility:public"],
+)
+
+cc_library(
+    name = "lib",
+    srcs = [":libjvm"],
+    hdrs = ["include/jni.h", "include/jni_md.h"],
+    strip_include_prefix = "include",
+    linkstatic = 1,
+    visibility = ["//visibility:public"],
+)
+
+# XXX Temporary workaround for
+# https://github.com/bazelbuild/bazel/issues/8180.
+genrule(
+    name = "rpath",
+    srcs = ["@openjdk//:libjvm"],
+    cmd = "libjvm=$(location :libjvm); echo -rpath $$(dirname $$(realpath $$libjvm)) > $@",
+    outs = ["openjdk_response_file"],
+    visibility = ["//visibility:public"],
+)
+""",
+)
+
+RULES_JVM_EXTERNAL_TAG = "3.3"
+RULES_JVM_EXTERNAL_SHA = "d85951a92c0908c80bd8551002d66cb23c3434409c814179c0ff026b53544dab"
+
+http_archive(
+    name = "rules_jvm_external",
+    strip_prefix = "rules_jvm_external-%s" % RULES_JVM_EXTERNAL_TAG,
+    sha256 = RULES_JVM_EXTERNAL_SHA,
+    url = "https://github.com/bazelbuild/rules_jvm_external/archive/%s.zip" % RULES_JVM_EXTERNAL_TAG,
+)
+
+load("@rules_jvm_external//:defs.bzl", "maven_install")
+
+maven_install(
+    artifacts = [
+        "org.apache.commons:commons-collections4:4.1",
+        "com.wizzardo:http:0.3",
+        "com.wizzardo:epoll:0.3.4",
+        "com.wizzardo:reactive-pg-client:0.10.2.1",
+        "com.wizzardo.tools:tools-collections:0.23",
+        "com.wizzardo.tools:tools-interfaces:0.23",
+    ],
+    repositories = [
+        "https://maven.google.com",
+        "https://repo1.maven.org/maven2",
+    ],
+)
+
+http_archive(
+    name = "inline_java",
+    # sha256 = "2b36e26fde296dc9fbaeed087c898fdce23af0247592e897c317d19345b0e259",
+    strip_prefix = "inline-java-1e2ce404b98ef84de7737665541aa73a426f5523",
+    urls = ["https://github.com/tweag/inline-java/archive/1e2ce404b98ef84de7737665541aa73a426f5523.zip"],
+)

+ 1 - 2
frameworks/Haskell/wizzardo-inline/benchmark_config.json

@@ -20,8 +20,7 @@
         "database_os": "Linux",
         "display_name": "wizzardo-inline",
         "notes": "",
-        "versus": "warp",
-        "tags": ["broken"]
+        "versus": "warp"
       }
     }
   ]

+ 0 - 1
frameworks/Haskell/wizzardo-inline/env-linear.sh

@@ -3,4 +3,3 @@
 export C_INCLUDE_PATH="$JAVA_HOME/include:$JAVA_HOME/include/linux"
 export LIBRARY_PATH="$JAVA_HOME/jre/lib/amd64/server:$JAVA_HOME/lib/server"
 export LD_LIBRARY_PATH="$LIBRARY_PATH"
-export STACK_YAML=stack-linear.yaml

+ 28 - 0
frameworks/Haskell/wizzardo-inline/nixpkgs.nix

@@ -0,0 +1,28 @@
+# Trying to workaround
+# https://github.com/NixOS/nixpkgs/issues/105573
+#
+# by going to a commit before the one introducing the regression.
+args:
+let pkgs = import (fetchTarball "https://github.com/tweag/nixpkgs/archive/73ad5f9e147.tar.gz") args;
+    stack_ignore_global_hints = pkgs.writeScriptBin "stack" ''
+      #!${pkgs.stdenv.shell}
+      # Skips the --global-hints parameter to stack. This is
+      # necessary when using an unreleased compiler whose hints
+      # aren't available yet.
+      set -euo pipefail
+      
+      declare -a args
+      for a in "''$@"
+      do
+          if [[ "$a" != "--global-hints" ]]
+          then
+              args+=("$a")
+          fi
+      done
+      # Passing --no-nix is necessary on nixos to stop stack from
+      # looking for nixpkgs.
+      # --system-ghc is also necessary to pick the unreleased compiler
+      # from the PATH.
+      exec ${pkgs.stack}/bin/stack --no-nix --system-ghc ''${args[@]}
+      '';
+ in pkgs // { inherit stack_ignore_global_hints; }

+ 30 - 0
frameworks/Haskell/wizzardo-inline/shell.nix

@@ -0,0 +1,30 @@
+{pkgs ? import ./nixpkgs.nix {}}:
+
+with pkgs;
+
+mkShell {
+  # XXX: hack for macosX, this flags disable bazel usage of xcode
+  # Note: this is set even for linux so any regression introduced by this flag
+  # will be catched earlier
+  # See: https://github.com/bazelbuild/bazel/issues/4231
+  BAZEL_USE_CPP_ONLY_TOOLCHAIN=1;
+
+  # Set UTF-8 local so that run-tests can parse GHC's unicode output.
+  LANG="C.UTF-8";
+
+  buildInputs = [
+    bazel_4
+    git
+    gnused
+    nix
+    openjdk11
+    python3
+    which
+    # For stack_install.
+    stack
+    # Needed to get correct locale for tests with encoding
+    glibcLocales
+    # to avoid CA certificate failures on macOS CI
+    cacert
+  ];
+}

+ 9 - 0
frameworks/Haskell/wizzardo-inline/snapshot-9.0.2.yaml

@@ -0,0 +1,9 @@
+resolver: lts-19.30
+
+packages:
+- github: tweag/distributed-closure
+  commit: b92e75ec81e646703c7bde4f578a7352ee34f1ad
+- github: ekmett/exceptions
+  commit: d7b742dc129790778f7b6d3347af80c8d69f8fcd
+- github: tweag/linear-base
+  commit: ec0b5aa6dc89f1d7c7e368b7387e363a5062e52d

+ 0 - 39
frameworks/Haskell/wizzardo-inline/stack-linear.yaml

@@ -1,39 +0,0 @@
-require-stack-version: ">= 1.6"
-
-resolver: lts-14.6
-compiler: ghc-8.9
-skip-ghc-check: true
-system-ghc: true
-allow-newer: true
-
-packages:
-- wizzardo-http-benchmark
-
-flags:
-  jni:
-    linear-types: true
-  jvm:
-    linear-types: true
-  inline-java:
-    linear-types: true
-
-extra-deps:
-- primitive-0.7.0.0
-- parsec-3.1.13.0 # Pinning parsec avoids rebuilding Cabal
-- Cabal-3.0.0.0
-- constraints-0.11
-- inline-c-0.8.0.1
-- git: https://github.com/tweag/inline-java
-  commit: 5b2552fae1beae88bebe2144da317e7182d759fc
-  subdirs:
-  - jni
-  - jvm
-  - .
-- git: https://github.com/facundominguez/malcolm-wallace-universe
-  commit: 2d02e4e2bcb5840152a1daa05a0ecfff089c6426
-  subdirs:
-  - polyparse-1.12
-- git: https://github.com/tweag/distributed-closure
-  commit: 3c9d3e0c9c2ae224ecd84dd4f9a38bedc2cdfd21
-- git: https://github.com/tweag/linear-base
-  commit: 4d43dc099f6f1381b949ee29ac63ce3088597ab0

+ 52 - 0
frameworks/Haskell/wizzardo-inline/wizzardo-http-benchmark/BUILD.bazel

@@ -0,0 +1,52 @@
+load(
+  "@rules_haskell//haskell:defs.bzl",
+  "haskell_binary",
+)
+
+java_library(
+    name = "wizzardo-http-benchmark_java",
+    srcs = glob(['src/main/**/*.java']),
+)
+
+java_deps = [
+    "wizzardo-http-benchmark_java",
+    "@maven//:com_wizzardo_http_0_3",
+    "@maven//:com_wizzardo_epoll_0_3_4",
+    "@maven//:com_wizzardo_tools_tools_collections_0_23",
+    "@maven//:com_wizzardo_tools_tools_interfaces_0_23",
+    "@maven//:com_wizzardo_reactive_pg_client_0_10_2_1",
+    ]
+
+java_binary(
+    name = "jar",
+    main_class = "bogus",
+    visibility = ["//visibility:public"],
+    runtime_deps = java_deps,
+)
+
+haskell_binary(
+    name = "wizzardo-http-benchmark",
+    srcs = glob(['src/main/**/*.hs']),
+    extra_srcs = ["@openjdk//:rpath"],
+    compiler_flags = [
+        "-optl-Wl,@$(location @openjdk//:rpath)",
+        "-threaded",
+        "-rtsopts",
+    ],
+    deps = [
+        "@rules_haskell//tools/runfiles",
+        "@stackage//:aeson",
+        "@stackage//:base",
+        "@stackage//:bytestring",
+        "@inline_java//:inline-java",
+        "@inline_java//jni",
+        "@inline_java//jvm",
+        "@stackage//:linear-base",
+        "@stackage//:monad-logger",
+        "@stackage//:mtl",
+        "@stackage//:singletons",
+        "@stackage//:text",
+    ] + java_deps,
+    data = [":jar_deploy.jar"],
+    plugins = ["@inline_java//:inline-java-plugin"],
+)

+ 18 - 16
frameworks/Haskell/wizzardo-inline/wizzardo-http-benchmark/src/main/haskell/DbHandler.hs

@@ -1,8 +1,8 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -13,20 +13,20 @@
 -- https://github.com/TechEmpower/FrameworkBenchmarks/blob/master/frameworks/wizzardo-http
 module DbHandler (createDbHandler) where
 
+import qualified Control.Functor.Linear as Linear
 import Control.Monad.IO.Class.Linear (MonadIO)
-import qualified Control.Monad.Linear.Builder as Linear
 import Data.Aeson (ToJSON(..), encode, object, (.=))
 import Data.ByteString.Lazy (toStrict)
 import Data.Int (Int32)
-import Data.String (fromString)
 import Foreign.JNI.Safe (newGlobalRef_)
 import qualified Language.Java as NonLinear
 import Language.Java.Inline.Safe
 import Language.Java.Function (createIntIntToObjFunction)
-import Language.Java.Safe (J, JType(..), type (<>))
+import Language.Java.Safe
+    (J, JType(..), UnsafeUnrestrictedReference(..), type (<>))
 import Wizzardo.Http.Handler (JHandler, createHandler)
-import Prelude (IO, Show, fromInteger, ($))
-import Prelude.Linear (Unrestricted(..))
+import Prelude (IO, Show, ($))
+import Prelude.Linear (Ur(..))
 import qualified System.IO.Linear as Linear
 
 imports "java.util.concurrent.ThreadLocalRandom"
@@ -40,19 +40,21 @@ imports "io.reactiverse.pgclient.impl.*"
 
 
 createDbHandler :: MonadIO m => m JHandler
-createDbHandler =
-    let Linear.Builder{..} = Linear.monadBuilder in do
+createDbHandler = Linear.do
     encodeDbResponse <- createIntIntToObjFunction encodeDbResponseAsJSON
-    Unrestricted jGlobalEncodeDbResponse <- newGlobalRef_ encodeDbResponse
+    UnsafeUnrestrictedReference jGlobalEncodeDbResponse <-
+      newGlobalRef_ encodeDbResponse
     byteBufferProviderThreadLocal <- createThreadLocalByteBufferProvider
-    Unrestricted jGlobalByteBufferProviderThreadLocal <-
+    UnsafeUnrestrictedReference jGlobalByteBufferProviderThreadLocal <-
       newGlobalRef_ byteBufferProviderThreadLocal
     poolRef <- createPgPoolRef
-    Unrestricted jGlobalPoolRef <- newGlobalRef_ poolRef
-    createHandler $ \req resp -> Linear.withLinearIO $ do
-      let uPoolRef = Unrestricted jGlobalPoolRef
-          uByteBufferProviderThreadLocal = Unrestricted jGlobalByteBufferProviderThreadLocal
-          uEncodeDbResponse = Unrestricted jGlobalEncodeDbResponse
+    UnsafeUnrestrictedReference jGlobalPoolRef <- newGlobalRef_ poolRef
+    createHandler $ \req resp -> Linear.withLinearIO $ Linear.do
+      let uPoolRef = UnsafeUnrestrictedReference jGlobalPoolRef
+          uByteBufferProviderThreadLocal =
+            UnsafeUnrestrictedReference jGlobalByteBufferProviderThreadLocal
+          uEncodeDbResponse =
+            UnsafeUnrestrictedReference jGlobalEncodeDbResponse
       [java| {
         int genWorldId = 1 + ThreadLocalRandom.current().nextInt(10000);
         $resp.async();
@@ -78,7 +80,7 @@ createDbHandler =
             $resp.reset();
         });
        } |]
-      return (Unrestricted ())
+      Linear.return (Ur ())
 
 data World = World { worldId :: Int32, worldRandomNumber :: Int32 }
   deriving Show

+ 12 - 26
frameworks/Haskell/wizzardo-inline/wizzardo-http-benchmark/src/main/haskell/Language/Java/Function.hs

@@ -4,9 +4,9 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -21,11 +21,9 @@ module Language.Java.Function
 import Control.Exception (SomeException, catch)
 import qualified Control.Monad
 import qualified Control.Monad.IO.Class.Linear as Linear
-import qualified Control.Monad.Linear.Builder as Linear
-import qualified Control.Monad.Linear as Linear
+import qualified Control.Functor.Linear as Linear
 import Data.Int
 import Data.Singletons
-import Data.String (fromString)
 import qualified Data.Text as Text
 import qualified Foreign.JNI as JNI
 import Foreign.JNI.Safe
@@ -35,7 +33,7 @@ import GHC.Stable
 import Language.Java.Inline.Safe
 import Language.Java.Safe
 import Prelude
-import Prelude.Linear (Unrestricted(..))
+import Prelude.Linear (Ur(..))
 import System.IO.Unsafe (unsafePerformIO)
 
 imports "io.tweag.inline_java.wizzardo_http_benchmark.*"
@@ -81,14 +79,7 @@ freeCallbackHandle _ _ = freeStablePtr . handleToStablePtr
 --
 -- TODO Maybe move this to a package to deal with function callbacks.
 createBiFunction
-  :: ( IsReferenceType a
-     , IsReferenceType b
-     , IsReferenceType c
-     , SingI a
-     , SingI b
-     , SingI c
-     , Linear.MonadIO m
-     )
+  :: Linear.MonadIO m
   => (NonLinear.J a -> NonLinear.J b -> IO (NonLinear.J c))
   -> m (J ('Class "java.util.function.BiFunction" <> [a, b, c]))
 createBiFunction f =
@@ -139,10 +130,7 @@ registerNativesForBiFunction = do
 -- The Haskell callback must return jnull or a local reference.
 --
 createIntIntToObjFunction
-  :: ( IsReferenceType a
-     , SingI a
-     , Linear.MonadIO m
-     )
+  :: Linear.MonadIO m
   => (Int32 -> Int32 -> IO (NonLinear.J a))
   -> m (J ('Iface "io.tweag.inline_java.wizzardo_http_benchmark.IntIntToObjFunction" <> '[a]))
 createIntIntToObjFunction f =
@@ -192,14 +180,13 @@ createCallback
   -> (StablePtrHandle f -> m (J ty))  -- ^ Instantiates the java callback which
                                       -- may have unregistered native methods
   -> m (J ty)
-createCallback f registerNativesForCallback createJFunction =
-    let Linear.Builder{..} = Linear.monadBuilder in do
-    Unrestricted longFunctionPtr <- Linear.liftIOU (createStablePtrHandle f)
+createCallback f registerNativesForCallback createJFunction = Linear.do
+    Ur longFunctionPtr <- Linear.liftSystemIOU (createStablePtrHandle f)
     jFunction <- createJFunction longFunctionPtr
-    (jFunction, Unrestricted klass) <- getObjectClass jFunction
-    Linear.liftIO (registerNativesForCallback klass)
-    Linear.liftIO (JNI.deleteLocalRef klass)
-    return jFunction
+    (jFunction, UnsafeUnrestrictedReference klass) <- getObjectClass jFunction
+    Linear.liftSystemIO (registerNativesForCallback klass)
+    Linear.liftSystemIO (JNI.deleteLocalRef klass)
+    Linear.return jFunction
 
 -- | Runs the Haskell callback referred by a 'StablePtrHandle' in the
 -- context of a Java function.
@@ -208,8 +195,7 @@ createCallback f registerNativesForCallback createJFunction =
 withJNICallbackHandle :: StablePtrHandle f -> a -> (f -> IO a) -> IO a
 withJNICallbackHandle h valueOnException m =
     (derefStablePtrHandle h >>= m) `catch` \(e :: SomeException) ->
-    fmap (const valueOnException) $ withLocalFrame_ $
-    let Linear.Builder{..} = Linear.monadBuilder in do
+    fmap (const valueOnException) $ withLocalFrame_ $ Linear.do
     jmsg <- reflect (Text.pack $ show e)
     e <- [java| new RuntimeException($jmsg) |]
     throw_ (e :: J ('Class "java.lang.RuntimeException"))

+ 28 - 27
frameworks/Haskell/wizzardo-inline/wizzardo-http-benchmark/src/main/haskell/Main.hs

@@ -1,45 +1,46 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Main where
 
-import qualified Control.Monad
+import qualified Bazel.Runfiles as Runfiles
+import Control.Exception (handle, throwIO)
 import Control.Monad.IO.Class.Linear (MonadIO)
-import qualified Control.Monad.Linear.Builder as Linear
+import qualified Control.Functor.Linear as Linear
 import Data.Aeson
-import qualified Data.Maybe as Maybe
 import qualified Data.ByteString.Char8 as ByteString.Char8
 import Data.ByteString.Lazy (toStrict)
 import Data.String (fromString)
 import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
 import DbHandler (createDbHandler)
+import qualified Foreign.JNI
 import Foreign.JNI.Safe (newGlobalRef_, withJVM, withLocalFrame_)
-import qualified Language.Haskell.TH.Syntax as TH
 import Language.Java.Inline.Safe
-import Language.Java.Safe (reflect)
-import System.Environment (getArgs, lookupEnv)
+import Language.Java.Safe (UnsafeUnrestrictedReference(..), reflect)
+import System.Environment (getArgs)
+import System.IO (stderr)
 import qualified System.IO.Linear as Linear
 import Wizzardo.Http.Handler (JHandler, createHandler)
-import Prelude (IO, (=<<), concat, fromInteger, map, ($), (++))
-import Prelude.Linear (Unrestricted(..))
-import Paths_wizzardo_http_benchmark (getDataFileName)
+import qualified Prelude
+import Prelude (IO, (<>), map, ($))
+import Prelude.Linear (Ur(..))
 
 imports "com.wizzardo.http.*"
 imports "com.wizzardo.http.framework.*"
 imports "com.wizzardo.http.request.*"
 
 main :: IO ()
-main =
-    getDataFileName "build/libs/wizzardo-http-benchmark.jar" Control.Monad.>>= \jar ->
-    getArgs Control.Monad.>>= \args -> do
+main = do
+    r <- Runfiles.create
+    let jarPath = Runfiles.rlocation r "io_tweag_inline_java/wizzardo-http-benchmark/jar_deploy.jar"
+        cpArg = "-Djava.class.path=" <> fromString jarPath
+    args <- getArgs
     let -- We use the classpath provided at build time.
-        cp = concat $ jar : ":" :
-               Maybe.maybeToList $(TH.lift =<< TH.runIO (lookupEnv "CLASSPATH"))
-        jvmArgs = [ fromString ("-Djava.class.path=" ++ cp) ]
         otherJVMArgs =
           [ "-Xmx2G"
           , "-Xms2G"
@@ -48,8 +49,7 @@ main =
           , "-XX:+UseParallelGC"
           , "-XX:+AggressiveOpts"
           ]
-    withJVM (jvmArgs ++ otherJVMArgs) $ withLocalFrame_ $
-      let Linear.Builder{..} = Linear.monadBuilder in do
+    withJVM (cpArg : otherJVMArgs) $ showJVMExceptions $ withLocalFrame_ $ Linear.do
       jsonHandler <- createJsonHandler
       jPlainTextHandler <- createPlainTextHandler
       jDbHandler <- createDbHandler
@@ -74,30 +74,31 @@ main =
         });
         application.start();
        } |]
+  where
+    showJVMExceptions = handle $ \e ->
+      Foreign.JNI.showException e Prelude.>>= Text.hPutStrLn stderr Prelude.>> throwIO e
 
 createJsonHandler :: MonadIO m => m JHandler
-createJsonHandler = createHandler $ \_req resp -> Linear.withLinearIO $
-    let Linear.Builder{..} = Linear.monadBuilder in do
+createJsonHandler = createHandler $ \_req resp -> Linear.withLinearIO $ Linear.do
     jmsg <- reflect (toStrict $ encode $ jsonObject resp)
     [java| { $resp
             .setBody($jmsg)
             .appendHeader(Header.KV_CONTENT_TYPE_APPLICATION_JSON);
            } |]
-    return (Unrestricted ())
+    Linear.return (Ur ())
   where
     -- Don't inline, so the serialization is not cached.
     {-# NOINLINE jsonObject #-}
     jsonObject _ = object ["message" .= Text.pack "Hello, World!"]
 
 createPlainTextHandler :: MonadIO m => m JHandler
-createPlainTextHandler =
-    let Linear.Builder{..} = Linear.monadBuilder in do
+createPlainTextHandler = Linear.do
     jmsg <- reflect (ByteString.Char8.pack "Hello, World!")
-    Unrestricted jGlobalMsg <- newGlobalRef_ jmsg
-    createHandler $ \_req resp -> Linear.withLinearIO $ do
-      let ujmsg = Unrestricted jGlobalMsg
+    UnsafeUnrestrictedReference jGlobalMsg <- newGlobalRef_ jmsg
+    createHandler $ \_req resp -> Linear.withLinearIO $ Linear.do
+      let ujmsg = UnsafeUnrestrictedReference jGlobalMsg
       [java| { $resp
                .setBody($ujmsg)
                .appendHeader(Header.KV_CONTENT_TYPE_TEXT_PLAIN);
              } |]
-      return (Unrestricted ())
+      Linear.return (Ur ())

+ 9 - 9
frameworks/Haskell/wizzardo-inline/wizzardo-http-benchmark/src/main/haskell/Wizzardo/Http/Handler.hs

@@ -3,9 +3,9 @@
 {-# LANGUAGE ForeignFunctionInterface #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -17,16 +17,14 @@ module Wizzardo.Http.Handler
   , createHandler
   ) where
 
+import qualified Control.Functor.Linear as Linear
 import qualified Control.Monad
 import qualified Control.Monad.IO.Class.Linear as Linear
-import qualified Control.Monad.Linear.Builder as Linear
-import Data.String (fromString)
 import qualified Foreign.JNI.Types as NonLinear
 import Language.Java.Function (createBiFunction)
 import Language.Java.Inline.Safe
 import Language.Java.Safe
 import Prelude
-import Prelude.Linear (Unrestricted(..))
 
 imports "com.wizzardo.http.*"
 imports "com.wizzardo.http.request.*"
@@ -40,14 +38,16 @@ type Request = 'Class "com.wizzardo.http.request.Request"
 
 createHandler
   :: Linear.MonadIO m
-  => (Unrestricted JRequest -> Unrestricted JResponse -> IO ())
+  => (  UnsafeUnrestrictedReference JRequest
+     -> UnsafeUnrestrictedReference JResponse
+     -> IO ()
+     )
   -> m JHandler
-createHandler handle =
-    let Linear.Builder{..} = Linear.monadBuilder in do
+createHandler handle = Linear.do
     f <- createBiFunction $ \req resp ->
       handle
-        (Unrestricted req)
-        (Unrestricted resp)
+        (UnsafeUnrestrictedReference req)
+        (UnsafeUnrestrictedReference resp)
       Control.Monad.>>
         Control.Monad.return resp
     [java| new Handler() {

+ 3 - 0
frameworks/Haskell/wizzardo-inline/wizzardo-http-benchmark/wizzardo-http-benchmark.cabal

@@ -27,6 +27,9 @@ executable wizzardo-http-benchmark
     jni,
     jvm,
     linear-base,
+    monad-logger,
+    mtl,
+    singletons,
     template-haskell,
     text
   default-language:    Haskell2010

+ 12 - 10
frameworks/Haskell/wizzardo-inline/wizzardo-inline.dockerfile

@@ -1,20 +1,22 @@
-FROM tweag/linear-types:1.0.5
+FROM nixos/nix
 MAINTAINER Facundo Dominguez <[email protected]>
 
-RUN apt-get update && apt-get install -y gradle openjdk-8-jdk
-
 USER root
 WORKDIR /wizzardo-inline
 
-COPY wizzardo-http-benchmark wizzardo-http-benchmark
-COPY stack-linear.yaml stack-linear.yaml
-COPY env-linear.sh env-linear.sh
-COPY set-java-home.sh set-java-home.sh
+COPY nixpkgs.nix nixpkgs.nix
+COPY shell.nix shell.nix
 
-RUN stack upgrade
+RUN nix-shell --run "echo Fetched dependencies"
+
+COPY wizzardo-http-benchmark wizzardo-http-benchmark
+COPY BUILD.bazel BUILD.bazel
+COPY WORKSPACE WORKSPACE
+COPY .bazelrc .bazelrc
+COPY snapshot-9.0.2.yaml snapshot-9.0.2.yaml
 
-RUN bash -c ". env-linear.sh; stack build wizzardo-http-benchmark --no-terminal"
+RUN nix-shell --run "bazel build //wizzardo-http-benchmark"
 
 EXPOSE 8080
 
-CMD bash -c ". env-linear.sh; stack exec -- wizzardo-http-benchmark env=prod +RTS -A32m -N$(nproc) -RTS"
+CMD nix-shell --run "bazel-bin/wizzardo-http-benchmark/wizzardo-http-benchmark env=prod +RTS -A32m -N$(nproc) -RTS"