You cannot select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
78 lines
2.5 KiB
Haskell
78 lines
2.5 KiB
Haskell
2 years ago
|
{-# LANGUAGE OverloadedStrings #-}
|
||
|
|
|
||
|
|
module Tests (test) where
|
||
|
|
|
||
|
|
import AOC (Solution (..))
|
||
|
|
import Data.Text qualified as T
|
||
|
|
import Data.Text.IO qualified as T
|
||
|
|
import Data.Void (Void)
|
||
|
|
import System.FilePath ((<.>), (</>))
|
||
|
|
import Test.Tasty (TestTree, testGroup)
|
||
|
|
import Test.Tasty.HUnit (testCase, (@=?))
|
||
|
|
import Test.Tasty.Ingredients (tryIngredients)
|
||
|
|
import Test.Tasty.Ingredients.Basic (consoleTestReporter)
|
||
|
|
import Text.Megaparsec
|
||
|
|
import Text.Megaparsec.Char (newline, space)
|
||
|
|
import Text.Megaparsec.Char.Lexer qualified as L
|
||
|
|
|
||
|
|
data TestInput = TestInput
|
||
|
|
{ _testName :: T.Text,
|
||
|
|
_testInput :: T.Text,
|
||
|
|
_testExpected :: T.Text
|
||
|
|
}
|
||
|
|
deriving (Show)
|
||
|
|
|
||
|
|
type Parser = Parsec Void T.Text
|
||
|
|
|
||
|
|
-- | Test solution via tests in 'data/examples/(Day #)/part{1,2}.txt'
|
||
|
|
test :: Solution -> Int -> Maybe Int -> IO ()
|
||
|
|
test (Solution pInput part1 part2) day part = do
|
||
|
|
p1 <- T.readFile $ "data" </> "examples" </> show day </> "part1" <.> "txt"
|
||
|
|
p2 <- T.readFile $ "data" </> "examples" </> show day </> "part2" <.> "txt"
|
||
|
|
|
||
|
|
let p1Tests =
|
||
|
|
testGroup "Part 1"
|
||
|
|
. fmap (mkTest pInput part1)
|
||
|
|
. either (error . errorBundlePretty) id
|
||
|
|
. parse pTests "part1.txt"
|
||
|
|
$ p1
|
||
|
|
p2Tests =
|
||
|
|
testGroup "Part 2"
|
||
|
|
. fmap (mkTest pInput part2)
|
||
|
|
. either (error . errorBundlePretty) id
|
||
|
|
. parse pTests "part2.txt"
|
||
|
|
$ p2
|
||
|
|
tests = testGroup ("Day " ++ show day) $ case part of
|
||
|
|
Nothing -> [p1Tests, p2Tests]
|
||
|
|
Just 1 -> [p1Tests]
|
||
|
|
_ -> [p2Tests]
|
||
|
|
|
||
|
|
case tryIngredients [consoleTestReporter] mempty tests of
|
||
|
|
Nothing -> error $ "Error running tests for day " ++ show day
|
||
|
|
Just act -> do
|
||
|
|
res <- act
|
||
|
|
putStrLn $ if res then "Success" else "Failure"
|
||
|
|
|
||
|
|
-- | Given an input parser, part1 or part2 function, and a test input,
|
||
|
|
-- generate an HUnit test.
|
||
|
|
mkTest :: Show b => (T.Text -> a) -> (a -> b) -> TestInput -> TestTree
|
||
|
|
mkTest pInput part TestInput {..} =
|
||
|
|
testCase (T.unpack _testName) $ T.unpack _testExpected @=? result
|
||
|
|
where
|
||
|
|
result = show . part $ pInput _testInput
|
||
|
|
|
||
|
|
-- | Parse test files into TestInput's
|
||
|
|
pTests :: Parser [TestInput]
|
||
|
|
pTests = many pTest <* eof
|
||
|
|
where
|
||
|
|
pTest = TestInput <$> pName <*> pInput <*> pExpected <?> "Test"
|
||
|
|
pName = T.pack <$> (symbol "-" *> lexeme (some (anySingleBut '\n'))) <?> "Test Name"
|
||
|
|
pInput = T.pack <$> someTill anySingle (symbol "==") <?> "Input Lines"
|
||
|
|
pExpected = T.pack <$> many (anySingleBut '\n') <* newline <?> "Expected Output"
|
||
|
|
|
||
|
|
lexeme :: Parser a -> Parser a
|
||
|
|
lexeme = L.lexeme space
|
||
|
|
|
||
|
|
symbol :: T.Text -> Parser T.Text
|
||
|
|
symbol = L.symbol space
|