Skip to content

Commit 62df075

Browse files
fix: adjust runner to not display Strings in quotes
1 parent 1bf6d8a commit 62df075

File tree

4 files changed

+25
-11
lines changed

4 files changed

+25
-11
lines changed

aoc/AOC.hs

Lines changed: 13 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,19 @@
1+
{-# language ScopedTypeVariables, GADTs #-}
2+
13
module AOC (
24
module AOC.Types,
3-
mkAocClient
5+
mkAocClient,
6+
showSolution,
47
) where
58

69
import AOC.Types
710
import AOC.API
11+
import Type.Reflection
12+
13+
-- TODO find a better way to avoid 'show'ing Stringlike things in
14+
-- quotes ("") without resorting to end-users having to wrap Solutions
15+
-- with something like data StringOr = StringLike a | NotStringLike b
16+
showSolution :: forall a. (Typeable a, Show a) => a -> String
17+
showSolution a = case eqTypeRep (typeRep @a) (typeRep @String) of
18+
Just HRefl -> a
19+
Nothing -> show a

aoc/AOC/Types.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,9 +7,11 @@ module AOC.Types (
77
import Data.Text (Text)
88
import GHC.Generics (Generic)
99
import Web.Internal.FormUrlEncoded (ToForm)
10+
import Type.Reflection
1011

1112
data Solution where
12-
Solution :: Show b => (Text -> a) -> (a -> b) -> (a -> b) -> Solution
13+
Solution :: (Typeable b, Show b) =>
14+
(Text -> a) -> (a -> b) -> (a -> b) -> Solution
1315

1416
data Submission = Submission {
1517
part :: Int,

runner/Main.hs

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
module Main where
22

3-
import AOC (Solution (..), mkAocClient)
3+
import AOC (Solution (..), mkAocClient, showSolution)
44
import Configuration.Dotenv (defaultConfig, loadFile)
55
import Control.Exception (IOException, catch)
66
import Control.Monad (when)
@@ -71,8 +71,8 @@ run (Solution pInput part1 part2) part input =
7171
Just n -> printf "Part %d: %s\n" n $ if n == 1 then part1' else part2'
7272
where
7373
parsed = pInput input
74-
part1' = show $ part1 parsed
75-
part2' = show $ part2 parsed
74+
part1' = showSolution $ part1 parsed
75+
part2' = showSolution $ part2 parsed
7676

7777
-- | CLI parser
7878
opts :: ParserInfo Options

runner/Tests.hs

Lines changed: 6 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,7 @@
22

33
module Tests (test) where
44

5-
import AOC (Solution (..))
5+
import AOC (Solution (..), showSolution)
66
import Data.Text qualified as T
77
import Data.Text.IO qualified as T
88
import Data.Void (Void)
@@ -14,6 +14,7 @@ import Test.Tasty.Ingredients.Basic (consoleTestReporter)
1414
import Text.Megaparsec
1515
import Text.Megaparsec.Char (newline, space)
1616
import Text.Megaparsec.Char.Lexer qualified as L
17+
import Type.Reflection
1718

1819
data TestInput = TestInput
1920
{ _testName :: T.Text,
@@ -55,13 +56,15 @@ test (Solution pInput part1 part2) day part = do
5556

5657
-- | Given an input parser, part1 or part2 function, and a test input,
5758
-- generate an HUnit test.
58-
mkTest :: Show b => (T.Text -> a) -> (a -> b) -> TestInput -> TestTree
59+
-- TODO this feels like a leaky abstraction of Solution
60+
mkTest :: (Typeable b, Show b) => (T.Text -> a) -> (a -> b) -> TestInput -> TestTree
5961
mkTest pInput part TestInput {..} =
6062
testCase (T.unpack _testName) $ T.unpack _testExpected @=? result
6163
where
62-
result = show . part $ pInput _testInput
64+
result = showSolution . part $ pInput _testInput
6365

6466
-- | Parse test files into TestInput's
67+
-- TODO more robust parsing and better, user-friendly custom errors
6568
pTests :: Parser [TestInput]
6669
pTests = many pTest <* eof
6770
where
@@ -71,8 +74,5 @@ pTests = many pTest <* eof
7174
pInput = T.pack <$> someTill anySingle (symbol "==") <?> "Input Lines"
7275
pExpected = T.pack <$> many (anySingleBut '\n') <* newline <?> "Expected Output"
7376

74-
lexeme :: Parser a -> Parser a
75-
lexeme = L.lexeme space
76-
7777
symbol :: T.Text -> Parser T.Text
7878
symbol = L.symbol space

0 commit comments

Comments
 (0)