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.
This commit is contained in:
George Thomas
parent
5b24dc1238
commit
450d7e5240
@ -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,38 +14,33 @@ 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
|
||||
. localOption (Always :: UseColor)
|
||||
. testGroup "tests"
|
||||
$ enumerate <&> \isRealData@(bool "examples" "real" -> t) ->
|
||||
testGroup t $
|
||||
[ Day1.puzzle
|
||||
, Day2.puzzle
|
||||
, Day3.puzzle
|
||||
, Day4.puzzle
|
||||
, Day5.puzzle
|
||||
, Day6.puzzle
|
||||
, Day7.puzzle
|
||||
, Day8.puzzle
|
||||
, Day9.puzzle
|
||||
, Day10.puzzle
|
||||
]
|
||||
<&> \Puzzle{number, parser, parts, extraTests} ->
|
||||
let
|
||||
pt = show number
|
||||
parseFile fp =
|
||||
either (fail . ("parse failure: " <>) . errorBundlePretty) pure
|
||||
. runParser (parser isRealData <* eof) fp
|
||||
=<< T.readFile fp
|
||||
in
|
||||
withResource (parseFile $ "../inputs/" <> t <> "/" <> pt) mempty \input ->
|
||||
testGroup pt $
|
||||
( flip mapWithIndexOutputParameterisedFunctionList parts \(show . succ -> n) pp ->
|
||||
goldenVsStringDiff n diffCommand ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
|
||||
TL.encodeUtf8 . (<> "\n") . TL.show . pp <$> input
|
||||
)
|
||||
<> [testGroup "extra" $ extraTests isRealData ("../outputs/" <> t <> "/" <> pt <> "/extra/") input]
|
||||
sydTest $ doNotRandomiseExecutionOrder $ for_ enumerate \isRealData@(bool "examples" "real" -> t) ->
|
||||
describe t $ for_
|
||||
[ Day1.puzzle
|
||||
, Day2.puzzle
|
||||
, Day3.puzzle
|
||||
, Day4.puzzle
|
||||
, Day5.puzzle
|
||||
, Day6.puzzle
|
||||
, Day7.puzzle
|
||||
, Day8.puzzle
|
||||
, Day9.puzzle
|
||||
, Day10.puzzle
|
||||
]
|
||||
\Puzzle{number, parser, parts, extraTests} ->
|
||||
let
|
||||
pt = show number
|
||||
parseFile fp =
|
||||
either (fail . ("parse failure: " <>) . errorBundlePretty) pure
|
||||
. runParser (parser isRealData <* eof) fp
|
||||
=<< T.readFile fp
|
||||
in
|
||||
describe pt do
|
||||
input <- liftIO $ parseFile $ "../inputs/" <> t <> "/" <> pt
|
||||
sequence_ $ flip mapWithIndexOutputParameterisedFunctionList parts \(show . succ -> n) pp ->
|
||||
it n . pureGoldenTextFile ("../outputs/" <> t <> "/" <> pt <> "/" <> n) $
|
||||
T.show (pp input) <> "\n"
|
||||
describe "extra" $ extraTests isRealData ("../outputs/" <> t <> "/" <> pt <> "/extra/") input
|
||||
|
||||
@ -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.Tasty.Golden,
|
||||
module Test.Tasty.HUnit,
|
||||
module Test.Syd,
|
||||
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.Tasty.Golden hiding (Always)
|
||||
import Test.Tasty.HUnit
|
||||
import Test.Syd
|
||||
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 ()
|
||||
|
||||
@ -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.Lazy.Encoding qualified as TL
|
||||
import Data.Text.Lazy.IO qualified as TL
|
||||
import Data.Text qualified as T
|
||||
import Data.Text.IO qualified as T
|
||||
|
||||
puzzle :: Puzzle
|
||||
puzzle =
|
||||
@ -21,31 +20,23 @@ puzzle =
|
||||
. mkGrid
|
||||
)
|
||||
/\ nil
|
||||
, extraTests = \isRealData path input ->
|
||||
[ testCase "round trip" do
|
||||
t <- TL.readFile if isRealData then "../inputs/real/4" else "../inputs/examples/4"
|
||||
input' <- input
|
||||
t @=? drawGrid (mkGrid input' <&> \case InEmpty -> OutEmpty; InRoll -> OutRoll)
|
||||
, withResource
|
||||
(Seq.fromList . takeUntil noneAccessible . fmap snd . generateFrames . mkGrid <$> input)
|
||||
mempty
|
||||
\frames ->
|
||||
testGroup
|
||||
"frames"
|
||||
let nFrames = if isRealData then 58 else 9
|
||||
in ( [0 .. nFrames] <&> \n ->
|
||||
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
|
||||
]
|
||||
]
|
||||
, extraTests = \isRealData path input -> do
|
||||
it "round trip" do
|
||||
t <- T.readFile if isRealData then "../inputs/real/4" else "../inputs/examples/4"
|
||||
drawGrid (mkGrid input <&> \case InEmpty -> OutEmpty; InRoll -> OutRoll) `shouldBe` t
|
||||
describe "frames" do
|
||||
let frames = Seq.fromList . takeUntil noneAccessible . fmap snd . generateFrames $ mkGrid input
|
||||
let nFrames = Seq.length frames - 1
|
||||
for_ [0 .. nFrames] \n ->
|
||||
it (show n) . pureGoldenTextFile (path <> "frames/" <> show n) $
|
||||
maybe "frame list too short!" drawGrid (Seq.lookup n frames)
|
||||
it "end" do
|
||||
Just g <- pure $ Seq.lookup nFrames frames
|
||||
(g `shouldSatisfyNamed` "accessible tile found") noneAccessible
|
||||
}
|
||||
|
||||
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 g) = TL.unlines . toList . fmap (TL.pack . toList . fmap outToChar) $ snd <<$>> g
|
||||
drawGrid :: Grid OutTile -> T.Text
|
||||
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 ..])
|
||||
|
||||
@ -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,
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user