From b405167551090c3818df55ec012b64645649d08f Mon Sep 17 00:00:00 2001
From: Maciej Jur <maciej@kamoshi.org>
Date: Wed, 6 Dec 2023 20:33:19 +0100
Subject: [PATCH] haskell: 2023 06

---
 2023/.inputs/06                 |  2 ++
 2023/haskell/aoc2023.cabal      |  1 +
 2023/haskell/app/Main.hs        |  6 ++++--
 2023/haskell/solutions/Day06.hs | 34 +++++++++++++++++++++++++++++++++
 2023/haskell/tests/Main.hs      | 14 ++++++++++++++
 5 files changed, 55 insertions(+), 2 deletions(-)
 create mode 100644 2023/.inputs/06
 create mode 100644 2023/haskell/solutions/Day06.hs

diff --git a/2023/.inputs/06 b/2023/.inputs/06
new file mode 100644
index 0000000..2214cba
--- /dev/null
+++ b/2023/.inputs/06
@@ -0,0 +1,2 @@
+Time:        51     69     98     78
+Distance:   377   1171   1224   1505
diff --git a/2023/haskell/aoc2023.cabal b/2023/haskell/aoc2023.cabal
index 9045900..158463b 100644
--- a/2023/haskell/aoc2023.cabal
+++ b/2023/haskell/aoc2023.cabal
@@ -23,6 +23,7 @@ library
     Day03
     Day04
     Day05
+    Day06
 
   -- other-modules:
 
diff --git a/2023/haskell/app/Main.hs b/2023/haskell/app/Main.hs
index 4bc00e2..fcb4f2f 100644
--- a/2023/haskell/app/Main.hs
+++ b/2023/haskell/app/Main.hs
@@ -6,7 +6,8 @@ import Utils (readInput)
 --import qualified Day02
 --import qualified Day03
 --import qualified Day04
-import qualified Day05
+--import qualified Day05
+import qualified Day06
 
 
 run :: (Show b, Show c)
@@ -30,5 +31,6 @@ main = do
   --run 2 Day02.parse Day02.solveA Day02.solveB
   --run 3 Day03.parse Day03.solveA Day03.solveB
   --run 4 Day04.parse Day04.solveA Day04.solveB
-  run 5 Day05.parse Day05.solveA Day05.solveB
+  --run 5 Day05.parse Day05.solveA Day05.solveB
+  run 6 Day06.parse Day06.solveA Day06.solveB
   pure ()
diff --git a/2023/haskell/solutions/Day06.hs b/2023/haskell/solutions/Day06.hs
new file mode 100644
index 0000000..8245e30
--- /dev/null
+++ b/2023/haskell/solutions/Day06.hs
@@ -0,0 +1,34 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Day06 (parse, solveA, solveB) where
+
+import Data.Void (Void)
+import Data.Text (Text)
+import Data.Bifunctor (first, bimap)
+import Control.Monad (join)
+import Text.Megaparsec (Parsec, errorBundlePretty, runParser, many, eof)
+import Text.Megaparsec.Char (string, space)
+import Text.Megaparsec.Char.Lexer (decimal)
+
+
+type Parser = Parsec Void Text
+
+
+parse :: Text -> Either String [(Int, Int)]
+parse = first errorBundlePretty . runParser races ""
+  where
+    numbers :: Text -> Parser [Int]
+    numbers s = string s *> space *> many (decimal <* space)
+    races :: Parser [(Int, Int)]
+    races = zip <$> numbers "Time:" <*> numbers "Distance:" <* eof
+
+travelled :: Int -> Int -> Int
+travelled t held = (t - held) * held
+
+choices :: (Int, Int) -> [Int]
+choices (t, d) = filter (d <) . map (travelled t) $ [1 .. t]
+
+solveA :: [(Int, Int)] -> Int
+solveA = product . map (length . choices)
+
+solveB :: [(Int, Int)] -> Int
+solveB = solveA . pure . join bimap (read . concatMap show) . unzip
diff --git a/2023/haskell/tests/Main.hs b/2023/haskell/tests/Main.hs
index f0fc034..fe45a01 100644
--- a/2023/haskell/tests/Main.hs
+++ b/2023/haskell/tests/Main.hs
@@ -8,6 +8,7 @@ import qualified Day02
 import qualified Day03
 import qualified Day04
 import qualified Day05
+import qualified Day06
 
 
 day01 :: Test
@@ -127,6 +128,18 @@ day05 =
       \60 56 37\n\
       \56 93 4\n"
 
+day06 :: Test
+day06 =
+  let parsed = Day06.parse input
+  in TestList
+      [ TestCase $ assertEqual "A" (Right 288)   (Day06.solveA <$> parsed)
+      , TestCase $ assertEqual "B" (Right 71503) (Day06.solveB <$> parsed)
+    ]
+  where
+    input =
+      "Time:      7  15   30\n\
+      \Distance:  9  40  200\n"
+
 tests :: Test
 tests = TestList
   [ TestLabel "day01" day01
@@ -134,6 +147,7 @@ tests = TestList
   , TestLabel "day03" day03
   , TestLabel "day04" day04
   , TestLabel "day05" day05
+  , TestLabel "day06" day06
   ]
 
 main :: IO ()