Unclogging.hs

{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell #-}

module Test.Unclogging (spec) where

import Control.Carrier.Unclog
import Control.Effect.Unclog.Json
import Data.Aeson
import Data.Foldable
import Data.Maybe
import Data.Traversable
import Test.Tasty
import Test.Tasty.HUnit
import Unclog
import UnliftIO

spec :: TestTree
spec =
  testGroup
    "all emitted logs arrive at all subscribers"
    [ testCase "using an IORef" do
        let emittedNumbers = map fromInteger [1 .. 200]
            threads = [1 .. 5000]
            json i = (["i" .= Number i] :: Object)

        refs <- for threads \n -> (n,) <$> newIORef []
        let subs = map (\(_, r) -> refSubscriber r) refs
        runUnclogging (colourSubscriber Debug stdout : subs) do
          for_ emittedNumbers \i -> do
            $debug $ json i
            $info $ json i
            $warn $ json i
            $fatal $ json i
        results <- for refs \(n, r) -> do
          r' <- readIORef r
          pure (n, fromMaybe (error "didn't deserialize correctly") . decodeStrict @Value . payload <$> reverse r')
        let targetPayload = foldMap (replicate 4 . Object . json) emittedNumbers
        for_ results \(n, r) -> do
          assertEqual ("payload of thread number " <> show @Integer n) targetPayload r
    ]