test: add TH compatibility tests

Author: drlkf

test/Control/Carrier/Logger/WriterSpec.hs

@@ -1,29 +1,68 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module Control.Carrier.Logger.WriterSpec (
   spec,
 ) where
 
 import Control.Carrier.Interpret (run)
 import Control.Carrier.Logger.Writer (runLoggerW)
-import Control.Monad.Logger (LogLevel (..), defaultLoc, logDebugN, logInfoN, logWarnN)
-import Test.Hspec (Spec, describe, it, shouldBe)
+import Control.Monad (forM_)
+import Control.Monad.Logger (
+  Loc (..),
+  LogLevel (..),
+  LogLine,
+  defaultLoc,
+  logDebugN,
+  logDebugS,
+  logInfoN,
+  logInfoS,
+  logWarnN,
+  logWarnS,
+ )
+import Test.Hspec (Spec, context, describe, it, shouldBe, shouldContain, shouldNotBe)
 
 spec :: Spec
 spec = do
   describe "LoggerWriterC" $ do
-    it "no log" $
-      run (runLoggerW (pure ())) `shouldBe` ([], ())
+    context "non-TH" $ do
+      it "no log" $
+        run (runLoggerW (pure ())) `shouldBe` ([], ())
 
-    it "3 logs" $ do
-      let action = do
-            logDebugN "1"
-            logInfoN "2"
-            logWarnN "3"
-          logLines =
-            [ (defaultLoc, "", LevelDebug, "1")
-            , (defaultLoc, "", LevelInfo, "2")
-            , (defaultLoc, "", LevelWarn, "3")
+      it "3 logs" $ do
+        let action = do
+              logDebugN "1"
+              logInfoN "2"
+              logWarnN "3"
+            logLines =
+              [ (defaultLoc, "", LevelDebug, "1")
+              , (defaultLoc, "", LevelInfo, "2")
+              , (defaultLoc, "", LevelWarn, "3")
+              ]
+
+        run (runLoggerW action) `shouldBe` (logLines, ())
+
+    it "TH" $ do
+      let action =
+            do
+              $logDebugS "test" "1"
+              $logInfoS "test" "2"
+              $logWarnS "test" "3"
+          expected =
+            [ (LevelDebug, "1")
+            , (LevelInfo, "2")
+            , (LevelWarn, "3")
             ]
+          results = run (runLoggerW action)
 
-      run (runLoggerW action) `shouldBe` (logLines, ())
+      length (fst results) `shouldBe` 3
+      forM_ (zip (fst results :: [LogLine]) expected) $
+        \((loc, src, lvl, msg), (expLvl, expMsg)) -> do
+          loc_filename loc `shouldBe` "test/Control/Carrier/Logger/WriterSpec.hs"
+          loc_package loc `shouldContain` "fused-effects-logger"
+          loc_module loc `shouldBe` "Control.Carrier.Logger.WriterSpec"
+          loc_start loc `shouldNotBe` (0, 0)
+          loc_end loc `shouldNotBe` (0, 0)
+          src `shouldBe` "test"
+          lvl `shouldBe` expLvl
+          msg `shouldBe` expMsg