Port from Tasty to Sydtest

There are some drawbacks:
- No properly lazy golden tests. This would in principle be nice when e.g. using `pretty-simple`.
- Because tests can be created dynamically, they can't be listed up front without running them. This presumably makes filtering slightly more annoying to use in practice.
- Terminal output is less compact than tasty, both horizontally and vertically. There appears to be no way to change this.
- We end up defining an orphan `Monoid (TestDefM '[] () ())` instance, to avoid changing much downstream code. Note though that this is not strictly necessary, and could potentially be contributed upstream.
- There's a warning about threads in GHCI which we can't seem to disable.
- The license forbids use in commercial projects without sponsoring. Thankfully that doesn't apply here.

Anyway, it's generally very impressive. It simplifies a few things for us, and will particularly help when we come to want to specify dependencies between tests.

haskell/Main.hs

@@ -2,9 +2,8 @@ module Main (main) where
 
 import Pre
 
+import Data.Text qualified as T
 import Data.Text.IO qualified as T
-import Data.Text.Lazy qualified as TL
-import Data.Text.Lazy.Encoding qualified as TL
 import Puzzles.Day1 qualified as Day1
 import Puzzles.Day10 qualified as Day10
 import Puzzles.Day2 qualified as Day2
@@ -15,15 +14,11 @@ import Puzzles.Day6 qualified as Day6
 import Puzzles.Day7 qualified as Day7
 import Puzzles.Day8 qualified as Day8
 import Puzzles.Day9 qualified as Day9
-import Test.Tasty.Ingredients.ConsoleReporter
 
 main :: IO ()
 main =
-    defaultMain
+    sydTest $ doNotRandomiseExecutionOrder $ for_ enumerate \isRealData@(bool "examples" "real" -> t) ->
-        . localOption (Always :: UseColor)
+        describe t $ for_
-        . testGroup "tests"
-        $ enumerate <&> \isRealData@(bool "examples" "real" -> t) ->
-            testGroup t $
             [ Day1.puzzle
             , Day2.puzzle
             , Day3.puzzle
@@ -35,7 +30,7 @@ main =
             , Day9.puzzle
             , Day10.puzzle
             ]
-                    <&> \Puzzle{number, parser, parts, extraTests} ->
+            \Puzzle{number, parser, parts, extraTests} ->
                 let
                     pt = show number
                     parseFile fp =
@@ -43,10 +38,9 @@ main =
                             . runParser (parser isRealData <* eof) fp
                             =<< T.readFile fp
                  in
-                            withResource (parseFile $ "../inputs/" <> t <> "/" <> pt) mempty \input ->
+                    describe pt do
-                                testGroup pt $
+                        input <- liftIO $ parseFile $ "../inputs/" <> t <> "/" <> pt
-                                    ( flip mapWithIndexOutputParameterisedFunctionList parts \(show . succ -> n) pp ->
+                        sequence_ $ flip mapWithIndexOutputParameterisedFunctionList parts \(show . succ -> n) pp ->
-                                        goldenVsStringDiff n diffCommand ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
+                            it n . pureGoldenTextFile ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
-                                            TL.encodeUtf8 . (<> "\n") . TL.show . pp <$> input
+                                T.show (pp input) <> "\n"
-                                    )
+                        describe "extra" $ extraTests isRealData ("../outputs/" <> t <> "/" <> pt <> "/extra/") input
-                                        <> [testGroup "extra" $ extraTests isRealData ("../outputs/" <> t <> "/" <> pt <> "/extra/") input]

haskell/Pre.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE PackageImports #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
 
 module Pre (
     module BasePrelude,
@@ -28,9 +29,7 @@ module Pre (
     module Data.Word,
     module Linear,
     module Safe,
-    module Test.Tasty,
+    module Test.Syd,
-    module Test.Tasty.Golden,
-    module Test.Tasty.HUnit,
     module Text.Megaparsec,
     module Text.Megaparsec.Char,
     module Text.Megaparsec.Char.Lexer,
@@ -41,7 +40,6 @@ module Pre (
     allUnorderedPairs,
     adjacentPairs,
     sortPair,
-    diffCommand,
     OutputParameterisedFunctionList,
     mapOutputParameterisedFunctionList,
     mapWithIndexOutputParameterisedFunctionList,
@@ -90,9 +88,7 @@ import Data.Void
 import Data.Word
 import Linear (V2 (..))
 import Safe
-import Test.Tasty
+import Test.Syd
-import Test.Tasty.Golden hiding (Always)
-import Test.Tasty.HUnit
 import Text.Megaparsec hiding (Pos, State, Stream, many, some)
 import Text.Megaparsec.Char
 import Text.Megaparsec.Char.Lexer (decimal)
@@ -101,7 +97,7 @@ data Puzzle = forall input outputs. Puzzle
     { number :: Word
     , parser :: Bool -> Parsec Void Text input
     , parts :: OutputParameterisedFunctionList Show input outputs
-    , extraTests :: Bool -> FilePath -> IO input -> [TestTree]
+    , extraTests :: Bool -> FilePath -> input -> Spec
     }
 
 digit :: (Token s ~ Char, Num b, MonadParsec e s f) => f b
@@ -129,9 +125,6 @@ adjacentPairs = \case
 sortPair :: (Ord a) => (a, a) -> (a, a)
 sortPair (a, b) = if a <= b then (a, b) else (b, a)
 
-diffCommand :: FilePath -> FilePath -> [String]
-diffCommand a b = ["diff", "--color=always", a, b]
-
 infixr 9 /\
 (/\) :: (c output) => (input -> output) -> OutputParameterisedFunctionList c input outputs -> OutputParameterisedFunctionList c input (output : outputs)
 (/\) = OutputParameterisedFunctionListCons
@@ -163,3 +156,8 @@ mapWithIndexOutputParameterisedFunctionList f = go 0
     go i = \case
         OutputParameterisedFunctionListNil -> []
         OutputParameterisedFunctionListCons x xs -> f i x : go (i + 1) xs
+
+instance Semigroup (TestDefM '[] () ()) where
+    (<>) = (>>)
+instance Monoid (TestDefM '[] () ()) where
+    mempty = pure ()

haskell/Puzzles/Day4.hs

@@ -4,9 +4,8 @@ import Pre
 
 import Data.Sequence qualified as Seq
 import Data.Stream.Infinite qualified as S
-import Data.Text.Lazy qualified as TL
+import Data.Text qualified as T
-import Data.Text.Lazy.Encoding qualified as TL
+import Data.Text.IO qualified as T
-import Data.Text.Lazy.IO qualified as TL
 
 puzzle :: Puzzle
 puzzle =
@@ -21,31 +20,23 @@ puzzle =
                         . mkGrid
                    )
                 /\ nil
-        , extraTests = \isRealData path input ->
+        , extraTests = \isRealData path input -> do
-            [ testCase "round trip" do
+            it "round trip" do
-                t <- TL.readFile if isRealData then "../inputs/real/4" else "../inputs/examples/4"
+                t <- T.readFile if isRealData then "../inputs/real/4" else "../inputs/examples/4"
-                input' <- input
+                drawGrid (mkGrid input <&> \case InEmpty -> OutEmpty; InRoll -> OutRoll) `shouldBe` t
-                t @=? drawGrid (mkGrid input' <&> \case InEmpty -> OutEmpty; InRoll -> OutRoll)
+            describe "frames" do
-            , withResource
+                let frames = Seq.fromList . takeUntil noneAccessible . fmap snd . generateFrames $ mkGrid input
-                (Seq.fromList . takeUntil noneAccessible . fmap snd . generateFrames . mkGrid <$> input)
+                let nFrames = Seq.length frames - 1
-                mempty
+                for_ [0 .. nFrames] \n ->
-                \frames ->
+                    it (show n) . pureGoldenTextFile (path <> "frames/" <> show n) $
-                    testGroup
+                        maybe "frame list too short!" drawGrid (Seq.lookup n frames)
-                        "frames"
+                it "end" do
-                        let nFrames = if isRealData then 58 else 9
+                    Just g <- pure $ Seq.lookup nFrames frames
-                         in ( [0 .. nFrames] <&> \n ->
+                    (g `shouldSatisfyNamed` "accessible tile found") noneAccessible
-                                goldenVsStringDiff (show n) diffCommand (path <> "frames/" <> show n) $
-                                    TL.encodeUtf8 . maybe "frame list too short!" drawGrid . Seq.lookup n <$> frames
-                            )
-                                <> [ testCase "end" do
-                                        Just g <- Seq.lookup nFrames <$> frames
-                                        assertBool "accessible tile found" $ noneAccessible g
-                                   ]
-            ]
         }
 
 newtype Grid a = Grid (Seq (Seq (V2 Int, a)))
-    deriving (Functor)
+    deriving (Functor, Show)
 
 data InTile
     = InEmpty
@@ -67,8 +58,8 @@ outToChar = \case
     OutRoll -> inToChar InRoll
     OutAccessible -> 'x'
 
-drawGrid :: Grid OutTile -> TL.Text
+drawGrid :: Grid OutTile -> T.Text
-drawGrid (Grid g) = TL.unlines . toList . fmap (TL.pack . toList . fmap outToChar) $ snd <<$>> g
+drawGrid (Grid g) = T.unlines . toList . fmap (T.pack . toList . fmap outToChar) $ snd <<$>> g
 
 mkGrid :: [[a]] -> Grid a
 mkGrid = Grid . Seq.fromList . map Seq.fromList . zipWith (map . first . V2) [0 ..] . map (zip [0 ..])

haskell/aoc.cabal

@@ -39,6 +39,9 @@ executable aoc
     ghc-options:
         -Wall
         -fdefer-type-errors
+        -threaded
+        -rtsopts
+        -with-rtsopts=-N
     build-depends:
         base >= 4.14,
         async,
@@ -60,11 +63,9 @@ executable aoc
         mtl,
         pretty-simple,
         safe,
+        sydtest,
         stm,
         streams,
-        tasty-golden,
-        tasty-hunit,
-        tasty,
         text,
         time,
         transformers,