Fix CI etc.

.envrc

@@ -1,2 +1,3 @@
+use nix
 dotenv
 dotenv_if_exists .env.local

.github/workflows/haskell.yml

@@ -2,10 +2,10 @@ on:
   push:
   pull_request:
 jobs:
-  stack-ghc-8_12:
+  stack-ghc-8_10:
     runs-on: ubuntu-latest
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
       - uses: cachix/install-nix-action@v22
         with:
           nix_path: nixpkgs=channel:nixos-23.05
@@ -20,16 +20,16 @@ jobs:
           path: |
             ~/.stack
             .stack-work
-          key: stack-${{ runner.os }}-8.12-${{ hashFiles('stack-ghc-8.12.yaml.lock') }}-2
+          key: stack-${{ runner.os }}-8.10-${{ hashFiles('stack-ghc-8.10.yaml.lock') }}-2
           restore-keys: |
-      - run: stack --stack-yaml stack-ghc-8.12.yaml build --only-dependencies
-      - run: stack --stack-yaml stack-ghc-8.12.yaml build
-      - run: stack --stack-yaml stack-ghc-8.12.yaml test
-      - run: stack --stack-yaml stack-ghc-8.12.yaml bench --no-run-benchmarks
+      - run: stack --stack-yaml stack-ghc-8.10.yaml build --only-dependencies
+      - run: stack --stack-yaml stack-ghc-8.10.yaml build
+      - run: stack --stack-yaml stack-ghc-8.10.yaml test
+      - run: stack --stack-yaml stack-ghc-8.10.yaml bench --no-run-benchmarks
   stack-ghc-9_0:
     runs-on: ubuntu-latest
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
       - uses: cachix/install-nix-action@v22
         with:
           nix_path: nixpkgs=channel:nixos-23.05
@@ -50,10 +50,10 @@ jobs:
       - run: stack --stack-yaml stack-ghc-9.0.yaml build
       - run: stack --stack-yaml stack-ghc-9.0.yaml test
       - run: stack --stack-yaml stack-ghc-9.0.yaml bench --no-run-benchmarks
-  stack-ghc:
+  stack:
     runs-on: ubuntu-latest
     steps:
-      - uses: actions/checkout@v3
+      - uses: actions/checkout@v4
       - uses: cachix/install-nix-action@v22
         with:
           nix_path: nixpkgs=channel:nixos-23.05
@@ -74,10 +74,26 @@ jobs:
       - run: stack build
       - run: stack test
       - run: stack bench --no-run-benchmarks
+  cabal:
+    runs-on: ubuntu-latest
+    steps:
+      - uses: actions/checkout@v4
+      - uses: cachix/install-nix-action@v17
+        with:
+          nix_path: nixpkgs=channel:nixos-22.11
+      - uses: actions/cache@v3
+        with:
+          path: ~/.cabal
+          key: cabal-${{ runner.os }}-${{ hashFiles('cabal.project.freeze') }}
+      - run: nix-shell --run 'cabal update'
+      - run: nix-shell --run 'cabal v2-build --only-dependencies all'
+      - run: nix-shell --run 'cabal v2-build all'
+      - run: nix-shell --run 'cabal v2-test all'
+      - run: nix-shell --run 'cabal v2-build --enable-benchmarks all'
   format:
     runs-on: ubuntu-latest
     steps:
-      - uses: actions/checkout@v2
+      - uses: actions/checkout@v4
       - uses: haskell-actions/run-fourmolu@v9
         with:
           version: "0.13.1.0"

Makefile

@@ -7,11 +7,11 @@ all.stack-8.10:
 
 .PHONY: all.stack-9.0
 all.stack-9.0:
-	stack --stack-yaml stack.yaml build --test --bench
+	stack --stack-yaml stack-ghc-9.0.yaml build --test --bench
 
 .PHONY: all.stack-9.2
 all.stack-9.2:
-	stack --stack-yaml stack-ghc-9.2.yaml build --test --bench
+	stack --stack-yaml stack.yaml build --test --bench
 
 .PHONY: all.cabal-9.0
 all.cabal-9.0:
@@ -27,11 +27,11 @@ build.all.stack-8.10:
 
 .PHONY: build.all.stack-9.0
 build.all.stack-9.0:
-	stack --stack-yaml stack.yaml build --test --no-run-tests --bench --no-run-benchmarks
+	stack --stack-yaml stack-ghc-9.0.yaml build --test --no-run-tests --bench --no-run-benchmarks
 
 .PHONY: build.all.stack-9.2
 build.all.stack-9.2:
-	stack --stack-yaml stack-ghc-9.2.yaml build --test --no-run-tests --bench --no-run-benchmarks
+	stack --stack-yaml stack.yaml build --test --no-run-tests --bench --no-run-benchmarks
 
 .PHONY: build.all.cabal-9.0
 build.all.cabal-9.0:
@@ -46,6 +46,5 @@ format:
 format.check:
 	fourmolu --mode check $$(git ls-files | grep -E "\.hs$$")
 
-
 # Hack https://www.gnu.org/software/make/manual/html_node/Force-Targets.html
 FORCE:

api/src/OpenTelemetry/Trace/Core.hs

@@ -316,13 +316,14 @@ callerAttributes = case getCallStack callStack of
 
 
 srcAttributes :: (String, SrcLoc) -> H.HashMap Text Attribute
-srcAttributes (fn, loc) = H.fromList
-  [ ("code.function", toAttribute $ T.pack fn)
-  , ("code.namespace", toAttribute $ T.pack $ srcLocModule loc)
-  , ("code.filepath", toAttribute $ T.pack $ srcLocFile loc)
-  , ("code.lineno", toAttribute $ srcLocStartLine loc)
-  , ("code.package", toAttribute $ T.pack $ srcLocPackage loc)
-  ]
+srcAttributes (fn, loc) =
+  H.fromList
+    [ ("code.function", toAttribute $ T.pack fn)
+    , ("code.namespace", toAttribute $ T.pack $ srcLocModule loc)
+    , ("code.filepath", toAttribute $ T.pack $ srcLocFile loc)
+    , ("code.lineno", toAttribute $ srcLocStartLine loc)
+    , ("code.package", toAttribute $ T.pack $ srcLocPackage loc)
+    ]
 
 
 {- | Attributes are added to the end of the span argument list, so will be discarded

cabal.project

@@ -7,18 +7,18 @@ packages:
   , exporters/handle
   , exporters/in-memory
   , exporters/otlp
-  , propagators/datadog
-  , propagators/w3c
-  , propagators/b3
-  , instrumentation/conduit
   , instrumentation/cloudflare
+  , instrumentation/conduit
   , instrumentation/hspec
   , instrumentation/http-client
   , instrumentation/persistent
   , instrumentation/persistent-mysql
   , instrumentation/postgresql-simple
-  , instrumentation/yesod
   , instrumentation/wai
+  , instrumentation/yesod
+  , propagators/b3
+  , propagators/datadog
+  , propagators/w3c
   , utils/exceptions
   , vendors/honeycomb
 

exporters/otlp/src/OpenTelemetry/Exporter/OTLP.hs

@@ -1,9 +1,9 @@
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ScopedTypeVariables #-}
 
 -----------------------------------------------------------------------------
 
@@ -200,9 +200,8 @@ otlpExporter :: (MonadIO m) => OTLPExporterConfig -> m (Exporter OT.ImmutableSpa
 otlpExporter conf = do
   -- TODO, url parsing is janky
   -- TODO configurable retryDelay, maximum retry counts
-  let
-    defaultHost = "http://localhost:4318"
-    host = fromMaybe defaultHost $ otlpEndpoint conf
+  let defaultHost = "http://localhost:4318"
+      host = fromMaybe defaultHost $ otlpEndpoint conf
   req <- liftIO $ parseRequest (host <> "/v1/traces")
 
   let (encodingHeader, encoder) =
@@ -283,13 +282,13 @@ otlpExporter conf = do
         Left err@(HttpExceptionRequest req e)
           | HTTPClient.host req == "localhost"
           , HTTPClient.port req == 4317 || HTTPClient.port req == 4318
-          , ConnectionFailure _someExn <- e
-            -> do
-              pure $ Failure Nothing
+          , ConnectionFailure _someExn <- e ->
+              do
+                pure $ Failure Nothing
           | otherwise ->
-            if isRetryableException e
-              then exponentialBackoff
-              else pure $ Failure $ Just $ SomeException err
+              if isRetryableException e
+                then exponentialBackoff
+                else pure $ Failure $ Just $ SomeException err
         Left err -> do
           pure $ Failure $ Just $ SomeException err
         Right resp ->

fourmolu.yaml

@@ -29,10 +29,10 @@ haddock-style: multi-line
 haddock-style-module: null
 
 # Styling of let blocks (choices: auto, inline, newline, or mixed)
-let-style: auto
+let-style: inline
 
 # How to align the 'in' keyword with respect to the 'let' keyword (choices: left-align, right-align, or no-space)
-in-style: no-space
+in-style: right-align
 
 # Whether to put parentheses around a single constraint (choices: auto, always, or never)
 single-constraint-parens: auto

instrumentation/conduit/src/OpenTelemetry/Instrumentation/Conduit.hs

@@ -1,5 +1,5 @@
-{-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE OverloadedLists #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 module OpenTelemetry.Instrumentation.Conduit where
 

instrumentation/persistent-mysql/src/OpenTelemetry/Instrumentation/Persistent/MySQL.hs

@@ -52,16 +52,16 @@ import Text.Read (readMaybe)
 responsibility to properly close the connection pool when
 unneeded.  Use 'withMySQLPool' for automatic resource control.
 -}
-createMySQLPool ::
-  (MonadUnliftIO m, MonadLoggerIO m) =>
-  Otel.TracerProvider ->
-  -- | Additional attributes.
-  H.HashMap Text Otel.Attribute ->
-  -- | Connection information.
-  MySQL.ConnectInfo ->
-  -- | Number of connections to be kept open in the pool.
-  Int ->
-  m (Pool SqlBackend)
+createMySQLPool
+  :: (MonadUnliftIO m, MonadLoggerIO m)
+  => Otel.TracerProvider
+  -> H.HashMap Text Otel.Attribute
+  -- ^ Additional attributes.
+  -> MySQL.ConnectInfo
+  -- ^ Connection information.
+  -> Int
+  -- ^ Number of connections to be kept open in the pool.
+  -> m (Pool SqlBackend)
 createMySQLPool tp attrs ci = createSqlPool $ fmap snd . openMySQLConn tp attrs ci
 
 
@@ -70,18 +70,18 @@ The pool is properly released after the action finishes using
 it.  Note that you should not use the given 'ConnectionPool'
 outside the action since it may be already been released.
 -}
-withMySQLPool ::
-  (MonadLoggerIO m, MonadUnliftIO m) =>
-  Otel.TracerProvider ->
-  -- | Additional attributes.
-  H.HashMap Text Otel.Attribute ->
-  -- | Connection information.
-  MySQL.ConnectInfo ->
-  -- | Number of connections to be kept open in the pool.
-  Int ->
-  -- | Action to be executed that uses the connection pool.
-  (Pool SqlBackend -> m a) ->
-  m a
+withMySQLPool
+  :: (MonadLoggerIO m, MonadUnliftIO m)
+  => Otel.TracerProvider
+  -> H.HashMap Text Otel.Attribute
+  -- ^ Additional attributes.
+  -> MySQL.ConnectInfo
+  -- ^ Connection information.
+  -> Int
+  -- ^ Number of connections to be kept open in the pool.
+  -> (Pool SqlBackend -> m a)
+  -- ^ Action to be executed that uses the connection pool.
+  -> m a
 withMySQLPool tp attrs ci = withSqlPool $ fmap snd . openMySQLConn tp attrs ci
 
 
@@ -90,41 +90,40 @@ their tuple
 
 About attributes, see https://opentelemetry.io/docs/reference/specification/trace/semantic_conventions/database/.
 -}
-openMySQLConn ::
-  Otel.TracerProvider ->
-  -- | Additional attributes.
-  H.HashMap Text Otel.Attribute ->
-  -- | Connection information.
-  MySQL.ConnectInfo ->
-  LogFunc ->
-  IO (MySQL.Connection, SqlBackend)
+openMySQLConn
+  :: Otel.TracerProvider
+  -> H.HashMap Text Otel.Attribute
+  -- ^ Additional attributes.
+  -> MySQL.ConnectInfo
+  -- ^ Connection information.
+  -> LogFunc
+  -> IO (MySQL.Connection, SqlBackend)
 openMySQLConn tp attrs [email protected] {connectUser, connectPort, connectOptions, connectHost} logFunc = do
-  let
-    portAttr, transportAttr :: Otel.Attribute
-    portAttr = fromString $ show connectPort
-    transportAttr =
-      fromMaybe "ip_tcp" $
-        getLast $
-          fold $
-            connectOptions <&> \case
-              MySQL.Protocol p ->
-                Last $ Just $ case p of
-                  MySQL.TCP -> "ip_tcp"
-                  MySQL.Socket -> "other"
-                  MySQL.Pipe -> "pipe"
-                  MySQL.Memory -> "inproc"
-              _ -> Last Nothing
-    -- "net.sock.family" is unnecessary because it must be "inet" when "net.sock.peer.addr" or "net.sock.host.addr" is set.
-    attrs' =
-      H.union
-        [ ("db.connection_string", fromString $ showsPrecConnectInfoMasked 0 ci "")
-        , ("db.user", fromString connectUser)
-        , ("net.peer.port", portAttr)
-        , ("net.sock.peer.port", portAttr)
-        , ("net.transport", transportAttr)
-        , (maybe "net.peer.name" (const "net.sock.peer.addr") (readMaybe connectHost :: Maybe IP), fromString connectHost)
-        ]
-        attrs
+  let portAttr, transportAttr :: Otel.Attribute
+      portAttr = fromString $ show connectPort
+      transportAttr =
+        fromMaybe "ip_tcp" $
+          getLast $
+            fold $
+              connectOptions <&> \case
+                MySQL.Protocol p ->
+                  Last $ Just $ case p of
+                    MySQL.TCP -> "ip_tcp"
+                    MySQL.Socket -> "other"
+                    MySQL.Pipe -> "pipe"
+                    MySQL.Memory -> "inproc"
+                _ -> Last Nothing
+      -- "net.sock.family" is unnecessary because it must be "inet" when "net.sock.peer.addr" or "net.sock.host.addr" is set.
+      attrs' =
+        H.union
+          [ ("db.connection_string", fromString $ showsPrecConnectInfoMasked 0 ci "")
+          , ("db.user", fromString connectUser)
+          , ("net.peer.port", portAttr)
+          , ("net.sock.peer.port", portAttr)
+          , ("net.transport", transportAttr)
+          , (maybe "net.peer.name" (const "net.sock.peer.addr") (readMaybe connectHost :: Maybe IP), fromString connectHost)
+          ]
+          attrs
   (conn, backend) <- Orig.openMySQLConn ci logFunc
   backend' <- Otel.wrapSqlBackend' tp attrs' backend
   pure (conn, backend')
@@ -133,16 +132,16 @@ openMySQLConn tp attrs [email protected] {connectUser, connectPort, connectOp
 {- | Same as 'withMySQLPool', but instead of opening a pool
 of connections, only one connection is opened.
 -}
-withMySQLConn ::
-  (MonadUnliftIO m, MonadLoggerIO m) =>
-  Otel.TracerProvider ->
-  -- | Additional attributes.
-  H.HashMap Text Otel.Attribute ->
-  -- | Connection information.
-  MySQL.ConnectInfo ->
-  -- | Action to be executed that uses the connection.
-  (SqlBackend -> m a) ->
-  m a
+withMySQLConn
+  :: (MonadUnliftIO m, MonadLoggerIO m)
+  => Otel.TracerProvider
+  -> H.HashMap Text Otel.Attribute
+  -- ^ Additional attributes.
+  -> MySQL.ConnectInfo
+  -- ^ Connection information.
+  -> (SqlBackend -> m a)
+  -- ^ Action to be executed that uses the connection.
+  -> m a
 withMySQLConn tp attrs ci = withSqlConn $ fmap snd . openMySQLConn tp attrs ci