Ver código fonte

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 anos atrás
pai
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",
         "database_os": "Linux",
         "display_name": "wizzardo-inline",
         "display_name": "wizzardo-inline",
         "notes": "",
         "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 C_INCLUDE_PATH="$JAVA_HOME/include:$JAVA_HOME/include/linux"
 export LIBRARY_PATH="$JAVA_HOME/jre/lib/amd64/server:$JAVA_HOME/lib/server"
 export LIBRARY_PATH="$JAVA_HOME/jre/lib/amd64/server:$JAVA_HOME/lib/server"
 export LD_LIBRARY_PATH="$LIBRARY_PATH"
 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 DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -13,20 +13,20 @@
 -- https://github.com/TechEmpower/FrameworkBenchmarks/blob/master/frameworks/wizzardo-http
 -- https://github.com/TechEmpower/FrameworkBenchmarks/blob/master/frameworks/wizzardo-http
 module DbHandler (createDbHandler) where
 module DbHandler (createDbHandler) where
 
 
+import qualified Control.Functor.Linear as Linear
 import Control.Monad.IO.Class.Linear (MonadIO)
 import Control.Monad.IO.Class.Linear (MonadIO)
-import qualified Control.Monad.Linear.Builder as Linear
 import Data.Aeson (ToJSON(..), encode, object, (.=))
 import Data.Aeson (ToJSON(..), encode, object, (.=))
 import Data.ByteString.Lazy (toStrict)
 import Data.ByteString.Lazy (toStrict)
 import Data.Int (Int32)
 import Data.Int (Int32)
-import Data.String (fromString)
 import Foreign.JNI.Safe (newGlobalRef_)
 import Foreign.JNI.Safe (newGlobalRef_)
 import qualified Language.Java as NonLinear
 import qualified Language.Java as NonLinear
 import Language.Java.Inline.Safe
 import Language.Java.Inline.Safe
 import Language.Java.Function (createIntIntToObjFunction)
 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 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
 import qualified System.IO.Linear as Linear
 
 
 imports "java.util.concurrent.ThreadLocalRandom"
 imports "java.util.concurrent.ThreadLocalRandom"
@@ -40,19 +40,21 @@ imports "io.reactiverse.pgclient.impl.*"
 
 
 
 
 createDbHandler :: MonadIO m => m JHandler
 createDbHandler :: MonadIO m => m JHandler
-createDbHandler =
-    let Linear.Builder{..} = Linear.monadBuilder in do
+createDbHandler = Linear.do
     encodeDbResponse <- createIntIntToObjFunction encodeDbResponseAsJSON
     encodeDbResponse <- createIntIntToObjFunction encodeDbResponseAsJSON
-    Unrestricted jGlobalEncodeDbResponse <- newGlobalRef_ encodeDbResponse
+    UnsafeUnrestrictedReference jGlobalEncodeDbResponse <-
+      newGlobalRef_ encodeDbResponse
     byteBufferProviderThreadLocal <- createThreadLocalByteBufferProvider
     byteBufferProviderThreadLocal <- createThreadLocalByteBufferProvider
-    Unrestricted jGlobalByteBufferProviderThreadLocal <-
+    UnsafeUnrestrictedReference jGlobalByteBufferProviderThreadLocal <-
       newGlobalRef_ byteBufferProviderThreadLocal
       newGlobalRef_ byteBufferProviderThreadLocal
     poolRef <- createPgPoolRef
     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| {
       [java| {
         int genWorldId = 1 + ThreadLocalRandom.current().nextInt(10000);
         int genWorldId = 1 + ThreadLocalRandom.current().nextInt(10000);
         $resp.async();
         $resp.async();
@@ -78,7 +80,7 @@ createDbHandler =
             $resp.reset();
             $resp.reset();
         });
         });
        } |]
        } |]
-      return (Unrestricted ())
+      Linear.return (Ur ())
 
 
 data World = World { worldId :: Int32, worldRandomNumber :: Int32 }
 data World = World { worldId :: Int32, worldRandomNumber :: Int32 }
   deriving Show
   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 GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -21,11 +21,9 @@ module Language.Java.Function
 import Control.Exception (SomeException, catch)
 import Control.Exception (SomeException, catch)
 import qualified Control.Monad
 import qualified Control.Monad
 import qualified Control.Monad.IO.Class.Linear as Linear
 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.Int
 import Data.Singletons
 import Data.Singletons
-import Data.String (fromString)
 import qualified Data.Text as Text
 import qualified Data.Text as Text
 import qualified Foreign.JNI as JNI
 import qualified Foreign.JNI as JNI
 import Foreign.JNI.Safe
 import Foreign.JNI.Safe
@@ -35,7 +33,7 @@ import GHC.Stable
 import Language.Java.Inline.Safe
 import Language.Java.Inline.Safe
 import Language.Java.Safe
 import Language.Java.Safe
 import Prelude
 import Prelude
-import Prelude.Linear (Unrestricted(..))
+import Prelude.Linear (Ur(..))
 import System.IO.Unsafe (unsafePerformIO)
 import System.IO.Unsafe (unsafePerformIO)
 
 
 imports "io.tweag.inline_java.wizzardo_http_benchmark.*"
 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.
 -- TODO Maybe move this to a package to deal with function callbacks.
 createBiFunction
 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))
   => (NonLinear.J a -> NonLinear.J b -> IO (NonLinear.J c))
   -> m (J ('Class "java.util.function.BiFunction" <> [a, b, c]))
   -> m (J ('Class "java.util.function.BiFunction" <> [a, b, c]))
 createBiFunction f =
 createBiFunction f =
@@ -139,10 +130,7 @@ registerNativesForBiFunction = do
 -- The Haskell callback must return jnull or a local reference.
 -- The Haskell callback must return jnull or a local reference.
 --
 --
 createIntIntToObjFunction
 createIntIntToObjFunction
-  :: ( IsReferenceType a
-     , SingI a
-     , Linear.MonadIO m
-     )
+  :: Linear.MonadIO m
   => (Int32 -> Int32 -> IO (NonLinear.J a))
   => (Int32 -> Int32 -> IO (NonLinear.J a))
   -> m (J ('Iface "io.tweag.inline_java.wizzardo_http_benchmark.IntIntToObjFunction" <> '[a]))
   -> m (J ('Iface "io.tweag.inline_java.wizzardo_http_benchmark.IntIntToObjFunction" <> '[a]))
 createIntIntToObjFunction f =
 createIntIntToObjFunction f =
@@ -192,14 +180,13 @@ createCallback
   -> (StablePtrHandle f -> m (J ty))  -- ^ Instantiates the java callback which
   -> (StablePtrHandle f -> m (J ty))  -- ^ Instantiates the java callback which
                                       -- may have unregistered native methods
                                       -- may have unregistered native methods
   -> m (J ty)
   -> 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 <- 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
 -- | Runs the Haskell callback referred by a 'StablePtrHandle' in the
 -- context of a Java function.
 -- context of a Java function.
@@ -208,8 +195,7 @@ createCallback f registerNativesForCallback createJFunction =
 withJNICallbackHandle :: StablePtrHandle f -> a -> (f -> IO a) -> IO a
 withJNICallbackHandle :: StablePtrHandle f -> a -> (f -> IO a) -> IO a
 withJNICallbackHandle h valueOnException m =
 withJNICallbackHandle h valueOnException m =
     (derefStablePtrHandle h >>= m) `catch` \(e :: SomeException) ->
     (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)
     jmsg <- reflect (Text.pack $ show e)
     e <- [java| new RuntimeException($jmsg) |]
     e <- [java| new RuntimeException($jmsg) |]
     throw_ (e :: J ('Class "java.lang.RuntimeException"))
     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 DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TemplateHaskell #-}
 module Main where
 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 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 Data.Aeson
-import qualified Data.Maybe as Maybe
 import qualified Data.ByteString.Char8 as ByteString.Char8
 import qualified Data.ByteString.Char8 as ByteString.Char8
 import Data.ByteString.Lazy (toStrict)
 import Data.ByteString.Lazy (toStrict)
 import Data.String (fromString)
 import Data.String (fromString)
 import qualified Data.Text as Text
 import qualified Data.Text as Text
+import qualified Data.Text.IO as Text
 import DbHandler (createDbHandler)
 import DbHandler (createDbHandler)
+import qualified Foreign.JNI
 import Foreign.JNI.Safe (newGlobalRef_, withJVM, withLocalFrame_)
 import Foreign.JNI.Safe (newGlobalRef_, withJVM, withLocalFrame_)
-import qualified Language.Haskell.TH.Syntax as TH
 import Language.Java.Inline.Safe
 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 qualified System.IO.Linear as Linear
 import Wizzardo.Http.Handler (JHandler, createHandler)
 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.*"
 imports "com.wizzardo.http.framework.*"
 imports "com.wizzardo.http.framework.*"
 imports "com.wizzardo.http.request.*"
 imports "com.wizzardo.http.request.*"
 
 
 main :: IO ()
 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.
     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 =
         otherJVMArgs =
           [ "-Xmx2G"
           [ "-Xmx2G"
           , "-Xms2G"
           , "-Xms2G"
@@ -48,8 +49,7 @@ main =
           , "-XX:+UseParallelGC"
           , "-XX:+UseParallelGC"
           , "-XX:+AggressiveOpts"
           , "-XX:+AggressiveOpts"
           ]
           ]
-    withJVM (jvmArgs ++ otherJVMArgs) $ withLocalFrame_ $
-      let Linear.Builder{..} = Linear.monadBuilder in do
+    withJVM (cpArg : otherJVMArgs) $ showJVMExceptions $ withLocalFrame_ $ Linear.do
       jsonHandler <- createJsonHandler
       jsonHandler <- createJsonHandler
       jPlainTextHandler <- createPlainTextHandler
       jPlainTextHandler <- createPlainTextHandler
       jDbHandler <- createDbHandler
       jDbHandler <- createDbHandler
@@ -74,30 +74,31 @@ main =
         });
         });
         application.start();
         application.start();
        } |]
        } |]
+  where
+    showJVMExceptions = handle $ \e ->
+      Foreign.JNI.showException e Prelude.>>= Text.hPutStrLn stderr Prelude.>> throwIO e
 
 
 createJsonHandler :: MonadIO m => m JHandler
 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)
     jmsg <- reflect (toStrict $ encode $ jsonObject resp)
     [java| { $resp
     [java| { $resp
             .setBody($jmsg)
             .setBody($jmsg)
             .appendHeader(Header.KV_CONTENT_TYPE_APPLICATION_JSON);
             .appendHeader(Header.KV_CONTENT_TYPE_APPLICATION_JSON);
            } |]
            } |]
-    return (Unrestricted ())
+    Linear.return (Ur ())
   where
   where
     -- Don't inline, so the serialization is not cached.
     -- Don't inline, so the serialization is not cached.
     {-# NOINLINE jsonObject #-}
     {-# NOINLINE jsonObject #-}
     jsonObject _ = object ["message" .= Text.pack "Hello, World!"]
     jsonObject _ = object ["message" .= Text.pack "Hello, World!"]
 
 
 createPlainTextHandler :: MonadIO m => m JHandler
 createPlainTextHandler :: MonadIO m => m JHandler
-createPlainTextHandler =
-    let Linear.Builder{..} = Linear.monadBuilder in do
+createPlainTextHandler = Linear.do
     jmsg <- reflect (ByteString.Char8.pack "Hello, World!")
     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
       [java| { $resp
                .setBody($ujmsg)
                .setBody($ujmsg)
                .appendHeader(Header.KV_CONTENT_TYPE_TEXT_PLAIN);
                .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 ForeignFunctionInterface #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE LinearTypes #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QualifiedDo #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE RankNTypes #-}
-{-# LANGUAGE RebindableSyntax #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TemplateHaskell #-}
@@ -17,16 +17,14 @@ module Wizzardo.Http.Handler
   , createHandler
   , createHandler
   ) where
   ) where
 
 
+import qualified Control.Functor.Linear as Linear
 import qualified Control.Monad
 import qualified Control.Monad
 import qualified Control.Monad.IO.Class.Linear as Linear
 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 qualified Foreign.JNI.Types as NonLinear
 import Language.Java.Function (createBiFunction)
 import Language.Java.Function (createBiFunction)
 import Language.Java.Inline.Safe
 import Language.Java.Inline.Safe
 import Language.Java.Safe
 import Language.Java.Safe
 import Prelude
 import Prelude
-import Prelude.Linear (Unrestricted(..))
 
 
 imports "com.wizzardo.http.*"
 imports "com.wizzardo.http.*"
 imports "com.wizzardo.http.request.*"
 imports "com.wizzardo.http.request.*"
@@ -40,14 +38,16 @@ type Request = 'Class "com.wizzardo.http.request.Request"
 
 
 createHandler
 createHandler
   :: Linear.MonadIO m
   :: Linear.MonadIO m
-  => (Unrestricted JRequest -> Unrestricted JResponse -> IO ())
+  => (  UnsafeUnrestrictedReference JRequest
+     -> UnsafeUnrestrictedReference JResponse
+     -> IO ()
+     )
   -> m JHandler
   -> m JHandler
-createHandler handle =
-    let Linear.Builder{..} = Linear.monadBuilder in do
+createHandler handle = Linear.do
     f <- createBiFunction $ \req resp ->
     f <- createBiFunction $ \req resp ->
       handle
       handle
-        (Unrestricted req)
-        (Unrestricted resp)
+        (UnsafeUnrestrictedReference req)
+        (UnsafeUnrestrictedReference resp)
       Control.Monad.>>
       Control.Monad.>>
         Control.Monad.return resp
         Control.Monad.return resp
     [java| new Handler() {
     [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,
     jni,
     jvm,
     jvm,
     linear-base,
     linear-base,
+    monad-logger,
+    mtl,
+    singletons,
     template-haskell,
     template-haskell,
     text
     text
   default-language:    Haskell2010
   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]>
 MAINTAINER Facundo Dominguez <[email protected]>
 
 
-RUN apt-get update && apt-get install -y gradle openjdk-8-jdk
-
 USER root
 USER root
 WORKDIR /wizzardo-inline
 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
 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"