[Yesod Instrumentation] add subsite support

cabal.project

@@ -18,7 +18,8 @@ packages:
   , instrumentation/postgresql-simple
   , instrumentation/yesod
   , instrumentation/wai
-  -- , examples/yesod-minimal
+  , examples/yesod-minimal
+  , examples/yesod-subsite
   , utils/exceptions
 
 -- https://github.com/vincenthz/hs-memory/pull/93

cabal.project.freeze

@@ -1,5 +1,6 @@
 active-repositories: hackage.haskell.org:merge
 constraints: any.Cabal ==3.4.1.0,
+             any.Glob ==0.10.2,
              any.HUnit ==1.6.2.0,
              any.OneTuple ==0.3.1,
              any.Only ==0.1,
@@ -10,6 +11,8 @@ constraints: any.Cabal ==3.4.1.0,
              aeson -cffi +ordered-keymap,
              any.ansi-terminal ==0.11.4,
              ansi-terminal -example +win32-2-13-1,
+             any.ansi-wl-pprint ==0.6.9,
+             ansi-wl-pprint -example,
              any.appar ==0.1.8,
              any.array ==0.5.4.0,
              any.asn1-encoding ==0.9.6,
@@ -28,11 +31,13 @@ constraints: any.Cabal ==3.4.1.0,
              any.base-compat ==0.12.2,
              any.base-compat-batteries ==0.12.2,
              any.base-orphans ==0.8.7,
+             any.base16-bytestring ==1.0.2.0,
              any.base64-bytestring ==1.2.1.0,
              any.basement ==0.0.15,
              any.bifunctors ==5.5.14,
              bifunctors +semigroups +tagged,
              any.binary ==0.8.8.0,
+             any.binary-orphans ==1.0.3,
              any.bitvec ==1.1.3.0,
              bitvec -libgmp,
              any.blaze-builder ==0.4.2.2,
@@ -47,6 +52,8 @@ constraints: any.Cabal ==3.4.1.0,
              any.cabal-doctest ==1.0.9,
              any.call-stack ==0.4.0,
              any.case-insensitive ==1.2.1.0,
+             any.cassava ==0.5.3.0,
+             cassava -bytestring--lt-0_10_4,
              any.cereal ==0.5.8.3,
              cereal -bytestring-builder,
              any.charset ==0.3.9,
@@ -56,6 +63,7 @@ constraints: any.Cabal ==3.4.1.0,
              clientsession -test,
              any.clock ==0.8.3,
              clock -llvm,
+             any.code-page ==0.2.1,
              any.colour ==2.3.6,
              any.comonad ==5.0.8,
              comonad +containers +distributive +indexed-traversable,
@@ -67,22 +75,33 @@ constraints: any.Cabal ==3.4.1.0,
              contravariant +semigroups +statevar +tagged,
              any.cookie ==0.4.6,
              any.cprng-aes ==0.6.1,
+             any.criterion ==1.6.0.0,
+             criterion -embed-data-files -fast,
+             any.criterion-measurement ==0.2.0.0,
+             criterion-measurement -fast,
              any.crypto-api ==0.13.3,
              crypto-api -all_cpolys,
              any.crypto-cipher-types ==0.0.9,
              any.crypto-random ==0.0.9,
              any.cryptonite ==0.30,
              cryptonite -check_alignment +integer-gmp -old_toolchain_inliner +support_aesni +support_deepseq -support_pclmuldq +support_rdrand -support_sse +use_target_attributes,
+             any.css-text ==0.1.3.0,
              any.data-array-byte ==0.1.0.1,
+             any.data-default ==0.7.1.1,
              any.data-default-class ==0.1.2.0,
+             any.data-default-instances-containers ==0.0.1,
+             any.data-default-instances-dlist ==0.0.1,
+             any.data-default-instances-old-locale ==0.0.1,
              any.data-fix ==0.3.2,
              any.deepseq ==1.4.5.0,
+             any.dense-linear-algebra ==0.1.0.0,
              any.directory ==1.3.6.2,
              any.distributive ==0.6.2.1,
              distributive +semigroups +tagged,
              any.dlist ==1.0,
              dlist -werror,
              any.easy-file ==0.2.2,
+             any.email-validate ==2.3.2.18,
              any.entropy ==0.4.1.10,
              entropy -donotgetentropy,
              any.exceptions ==0.10.4,
@@ -93,9 +112,12 @@ constraints: any.Cabal ==3.4.1.0,
              any.ghc-bignum ==1.1,
              any.ghc-boot-th ==9.0.2,
              any.ghc-prim ==0.7.0,
+             any.happy ==1.20.0,
              any.hashable ==1.4.2.0,
              hashable +integer-gmp -random-initial-seed,
              any.haskell-lexer ==1.1.1,
+             any.haskell-src-exts ==1.23.1,
+             any.haskell-src-meta ==0.8.11,
              any.hourglass ==0.2.12,
              any.hsc2hs ==0.68.8,
              hsc2hs -in-ghc-tree,
@@ -120,6 +142,7 @@ constraints: any.Cabal ==3.4.1.0,
              any.integer-logarithms ==1.0.3.1,
              integer-logarithms -check-bounds +integer-gmp,
              any.iproute ==1.7.12,
+             any.js-chart ==2.9.4.1,
              any.lens-family ==2.1.2,
              any.lens-family-core ==2.1.2,
              any.lift-type ==0.1.1.1,
@@ -129,6 +152,7 @@ constraints: any.Cabal ==3.4.1.0,
              any.memory ==0.17.0,
              memory +support_bytestring +support_deepseq,
              any.microlens ==0.4.13.1,
+             any.microstache ==1.0.2.3,
              any.mime-types ==0.1.1.0,
              any.monad-control ==1.0.3.1,
              any.monad-logger ==0.3.37,
@@ -138,22 +162,36 @@ constraints: any.Cabal ==3.4.1.0,
              any.mono-traversable ==1.0.15.3,
              any.mtl ==2.2.2,
              any.mwc-random ==0.15.0.2,
+             any.mysql ==0.2.1,
+             mysql -developer,
+             any.mysql-simple ==0.4.9,
+             mysql-simple -developer,
              any.network ==3.1.2.7,
              network -devel,
              any.network-bsd ==2.8.1.0,
              any.network-byte-order ==0.1.6,
              any.network-uri ==2.6.4.2,
              any.old-locale ==1.0.0.7,
              any.old-time ==1.1.0.3,
+             any.optparse-applicative ==0.17.0.0,
+             optparse-applicative +process,
+             any.parallel ==3.2.2.0,
              any.parsec ==3.1.14.0,
              any.path-pieces ==0.2.1,
              any.pcg-random ==0.1.3.7,
+             any.pcre-light ==0.4.1.0,
+             pcre-light -old_base -use-pkg-config,
              any.pem ==0.2.4,
              any.persistent ==2.14.4.4,
+             any.persistent-mysql ==2.13.1.3,
+             any.persistent-postgresql ==2.13.5.0,
+             any.persistent-qq ==2.12.0.5,
+             any.persistent-template ==2.12.0.0,
              any.postgresql-libpq ==0.9.5.0,
              postgresql-libpq -use-pkg-config,
              any.postgresql-simple ==0.6.4,
              any.pretty ==1.1.3.6,
+             any.pretty-hex ==1.1,
              any.primitive ==0.7.4.0,
              any.process ==1.6.13.2,
              any.profunctors ==5.6.2,
@@ -168,6 +206,7 @@ constraints: any.Cabal ==3.4.1.0,
              any.resource-pool ==0.3.1.0,
              any.resourcet ==1.3.0,
              any.rts ==1.0.2,
+             any.safe ==0.3.19,
              any.safe-exceptions ==0.1.7.3,
              any.scientific ==0.3.7.0,
              scientific -bytestring-builder -integer-simple,
@@ -188,23 +227,30 @@ constraints: any.Cabal ==3.4.1.0,
              any.split ==0.2.3.5,
              any.splitmix ==0.1.0.4,
              splitmix -optimised-mixer,
+             any.statistics ==0.16.1.2,
              any.stm ==2.5.0.0,
              any.stm-chans ==3.0.0.6,
              any.streaming-commons ==0.2.2.5,
              streaming-commons -use-bytestring-builder,
              any.strict ==0.4.0.1,
              strict +assoc,
+             any.string-conversions ==0.4.0.1,
+             any.syb ==0.7.2.2,
              any.tagged ==0.8.6.1,
              tagged +deepseq +transformers,
+             any.tagsoup ==0.14.8,
              any.template-haskell ==2.17.0.0,
              any.text ==1.2.5.0,
              any.text-short ==0.1.5,
              text-short -asserts,
              any.tf-random ==0.5,
              any.th-abstraction ==0.4.5.0,
              any.th-compat ==0.1.4,
+             any.th-expand-syns ==0.4.10.0,
              any.th-lift ==0.8.2,
              any.th-lift-instances ==0.1.20,
+             any.th-orphans ==0.13.14,
+             any.th-reify-many ==0.1.10,
              any.these ==1.1.1.1,
              these +assoc,
              any.thread-utils-context ==0.2.0.0,
@@ -231,15 +277,18 @@ constraints: any.Cabal ==3.4.1.0,
              any.unliftio-core ==0.2.0.1,
              any.unordered-containers ==0.2.19.1,
              unordered-containers -debug,
+             any.utf8-string ==1.0.2,
              any.uuid-types ==1.0.5,
              any.vault ==0.3.1.5,
              vault +useghc,
              any.vector ==0.13.0.0,
              vector +boundschecks -internalchecks -unsafechecks -wall,
              any.vector-algorithms ==0.9.0.1,
              vector-algorithms +bench +boundschecks -internalchecks -llvm +properties -unsafechecks,
+             any.vector-binary-instances ==0.2.5.2,
              any.vector-builder ==0.3.8.4,
              any.vector-stream ==0.1.0.0,
+             any.vector-th-unbox ==0.2.2,
              any.wai ==3.2.3,
              any.wai-extra ==3.1.13.0,
              wai-extra -build-example,
@@ -252,7 +301,11 @@ constraints: any.Cabal ==3.4.1.0,
              any.x509-store ==1.6.9,
              any.x509-system ==1.6.7,
              any.x509-validation ==1.6.12,
+             any.xss-sanitize ==0.3.7.1,
              any.yesod-core ==1.6.24.0,
+             any.yesod-form ==1.7.3,
+             yesod-form +network-uri,
+             any.yesod-persistent ==1.6.0.8,
              any.zlib ==0.6.3.0,
              zlib -bundled-c-zlib -non-blocking-ffi -pkg-config
 index-state: hackage.haskell.org 2023-01-13T05:15:22Z

docker-compose.yaml

@@ -0,0 +1,18 @@
+version: "3"
+
+services:
+  jaeger:
+    image: jaegertracing/all-in-one
+    environment:
+      - COLLECTOR_OTLP_ENABLED=true
+    ports:
+      - "4318:4318" # otelcol HTTP/JSON
+      - "16686:16686" # UI and API
+
+  postgres:
+    image: postgres
+    environment:
+      - POSTGRES_USER=otel
+      - POSTGRES_PASSWORD=password
+    ports:
+      - "5432:5432"

examples/yesod-minimal/src/Minimal.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE QuasiQuotes #-}
@@ -58,6 +59,10 @@ data Minimal = Minimal
   }
 
 
+instance MonadTracer (HandlerFor Minimal) where
+  getTracer = getTracerWithGlobalTracerProvider
+
+
 $( do
     let routes =
           [parseRoutes|
@@ -66,8 +71,8 @@ $( do
         |]
     Prelude.concat
       <$> Prelude.sequence
-        [ mkRouteToRenderer ''Minimal routes
-        , mkRouteToPattern ''Minimal routes
+        [ mkRouteToRenderer ''Minimal mempty routes
+        , mkRouteToPattern ''Minimal mempty routes
         , mkYesod "Minimal" routes
         ]
  )

examples/yesod-subsite/.gitignore

@@ -0,0 +1 @@
+/bin/

examples/yesod-subsite/Makefile

@@ -0,0 +1,19 @@
+.PHONY: server.run
+server.run:
+	docker compose --file ../../docker-compose.yaml up $(DOCKER_COMPOSE_OPTS)
+
+.PHONY: server.stop
+server.stop:
+	docker compose --file ../../docker-compose.yaml down $(DOCKER_COMPOSE_OPTS)
+
+.PHONY: app.run
+app.run: bin/yesod-subsite
+	OTEL_SERVICE_NAME=yesod-subsite bin/yesod-subsite $(YESOD_MINIMAL_OPTS)
+
+bin/yesod-subsite:
+	stack install --local-bin-path ./bin $(CABAL_OPTS) yesod-subsite:exe:yesod-subsite
+
+.PHONY: clean
+clean:
+	stack clean
+	$(RM) bin/yesod-subsite

examples/yesod-subsite/README.md

@@ -0,0 +1,29 @@
+# yesod-subsite Example
+
+This example shows how to use hs-opentelemetry-instrumentation-wai and hs-opentelemetry-instrumentation-yesod with Yesod subsite.
+
+## How to Run
+
+Run a following command to start Jaeger.
+
+```
+$ make server.run
+```
+
+Build and run this example in another shell.
+
+```
+$ make app.run
+```
+
+You can access following end points.
+
+- http://localhost:16686/
+  - Jaeger UI
+- http://localhost:3000/
+  - target app
+
+When you access http://localhost:3000/, Open Telemetry's traces are sent to the Jaeger.
+And you can see the traces at http://localhost:16686.
+
+![Screenshot of Jaeger](./image/jaeger-trace-example.png)

examples/yesod-subsite/src/Subsite.hs

@@ -0,0 +1,28 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
+-- an option for Template Haskell stage restriction
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Subsite (
+  module Subsite.Data,
+) where
+
+import Subsite.Data (
+  Route (FooR, SubHomeR),
+  Subsite (Subsite),
+  getFooR,
+  getSubHomeR,
+  resourcesSubsite,
+  routeToPattern,
+  routeToRenderer,
+ )
+import Yesod.Core (
+  YesodSubDispatch (yesodSubDispatch),
+  mkYesodSubDispatch,
+ )
+
+
+instance YesodSubDispatch Subsite master where
+  yesodSubDispatch = $(mkYesodSubDispatch resourcesSubsite)