feat: Add more thread context preserving combinators

freckle-app/library/Freckle/App/Async.hs

@@ -6,6 +6,10 @@ module Freckle.App.Async
   , ThreadContext (..)
   , getThreadContext
   , withThreadContext
+  , forConcurrently
+  , forConcurrently_
+  , mapConcurrently
+  , mapConcurrently_
   ) where
 
 import Freckle.App.Prelude
@@ -39,6 +43,30 @@ foldConcurrently xs = do
   context <- getThreadContext
   runConc $ foldMap (conc . withThreadContext context) xs
 
+-- | 'UnliftIO.Async.forConcurrently' but passing the thread context along
+forConcurrently
+  :: (MonadUnliftIO m, MonadMask m, Traversable t) => t a -> (a -> m b) -> m (t b)
+forConcurrently = flip mapConcurrently
+
+-- | 'UnliftIO.Async.mapConcurrently' but passing the thread context along
+mapConcurrently
+  :: (MonadUnliftIO m, MonadMask m, Traversable t) => (a -> m b) -> t a -> m (t b)
+mapConcurrently f xs = do
+  context <- getThreadContext
+  UnliftIO.mapConcurrently (withThreadContext context . f) xs
+
+-- | 'UnliftIO.Async.forConcurrently_' but passing the thread context along
+forConcurrently_
+  :: (MonadUnliftIO m, MonadMask m, Traversable t) => t a -> (a -> m b) -> m ()
+forConcurrently_ = flip mapConcurrently_
+
+-- | 'UnliftIO.Async.mapConcurrently_' but passing the thread context along
+mapConcurrently_
+  :: (MonadUnliftIO m, MonadMask m, Traversable t) => (a -> m b) -> t a -> m ()
+mapConcurrently_ f xs = do
+  context <- getThreadContext
+  UnliftIO.mapConcurrently_ (withThreadContext context . f) xs
+
 -- | Wrapper around creating "Control.Immortal" processes
 --
 -- Features:

freckle-http/library/Freckle/App/Test/Http/MatchRequest.hs

@@ -28,7 +28,6 @@ import Control.Monad (guard)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 qualified as BS8
 import Data.ByteString.Lazy qualified as BSL
-import Data.Foldable (toList)
 import Data.List (isPrefixOf)
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.List.NonEmpty qualified as NE
@@ -121,7 +120,7 @@ showMatchRequestWithMismatches :: MatchRequest -> NonEmpty String -> String
 showMatchRequestWithMismatches mr mismatches =
   showMatchRequest mr
     <> "\nMismatches {"
-    <> concatMap ("\n  " <>) (toList mismatches)
+    <> concatMap ("\n  " <>) mismatches
     <> "\n}"
     <> "\n"
 

hie.yaml

@@ -9,6 +9,9 @@ cradle:
     - path: "freckle-app/tests"
       component: "freckle-app:test:spec"
 
+    - path: "freckle-ecs/library"
+      component: "freckle-ecs:lib"
+
     - path: "freckle-env/library"
       component: "freckle-env:lib"
 
@@ -41,3 +44,6 @@ cradle:
 
     - path: "freckle-prelude/library"
       component: "freckle-prelude:lib"
+
+    - path: "freckle-stats/library"
+      component: "freckle-stats:lib"

stack.yaml.lock

@@ -1,7 +1,7 @@
 # This file was autogenerated by Stack.
 # You should not edit this file by hand.
 # For more information, please see the documentation at:
-#   https://docs.haskellstack.org/en/stable/topics/lock_files
+#   https://docs.haskellstack.org/en/stable/lock_files
 
 packages:
 - completed:
@@ -95,6 +95,13 @@ packages:
       size: 611
   original:
     hackage: monad-validate-1.3.0.0
+- completed:
+    hackage: persistent-sql-lifted-0.1.0.0@sha256:1d4e828d3b1e76071d212d3cf940e1d9effaa3f71a850030120a0ee91e3283f7,2550
+    pantry-tree:
+      sha256: 748213f3ee6b8be36451d3b8ec3d273356032b4d0ee5f7fe4819877438d5fb7b
+      size: 890
+  original:
+    hackage: persistent-sql-lifted-0.1.0.0
 - completed:
     hackage: thread-utils-context-0.3.0.4@sha256:e763da1c6cab3b6d378fb670ca74aa9bf03c9b61b6fcf7628c56363fb0e3e71e,1671
     pantry-tree: