From d30ceb56f7b141ee558bbd86775d7322d4767ba7 Mon Sep 17 00:00:00 2001
From: Alexander Kobjolke <me@failco.de>
Date: Thu, 7 Dec 2023 22:21:10 +0100
Subject: [PATCH] Solve 2023-05

---
 data/Y2023/D05/riddle |  1 +
 src/AoC.hs            |  2 +-
 src/AoC/Y2023/D05.hs  | 70 ++++++++++++++++++++++++++++++++-----------
 3 files changed, 54 insertions(+), 19 deletions(-)
 mode change 100644 => 120000 data/Y2023/D05/riddle

diff --git a/data/Y2023/D05/riddle b/data/Y2023/D05/riddle
deleted file mode 100644
index e69de29..0000000
diff --git a/data/Y2023/D05/riddle b/data/Y2023/D05/riddle
new file mode 120000
index 0000000..303e941
--- /dev/null
+++ b/data/Y2023/D05/riddle
@@ -0,0 +1 @@
+/home/alex/src/aoc/data/Y2023/D05/example
\ No newline at end of file
diff --git a/src/AoC.hs b/src/AoC.hs
index 252b192..28ae754 100644
--- a/src/AoC.hs
+++ b/src/AoC.hs
@@ -39,4 +39,4 @@ printResult (Left e) = putTextLn e
 printResult (Right s) = print s
 
 defaultMain :: IO ()
-defaultMain = Exception.catch (runAoC Y2023 D04 >>= printResult) handleError
+defaultMain = Exception.catch (runAoC Y2023 D05 >>= printResult) handleError
diff --git a/src/AoC/Y2023/D05.hs b/src/AoC/Y2023/D05.hs
index 4d6ccb5..0f580ed 100644
--- a/src/AoC/Y2023/D05.hs
+++ b/src/AoC/Y2023/D05.hs
@@ -2,9 +2,10 @@ module AoC.Y2023.D05 where
 
 import AoC.Parser
 import AoC.Riddle
-import Text.Megaparsec (choice, sepBy1)
+import Text.Megaparsec (choice, eof, sepBy, sepBy1, someTill, try)
+import Text.Megaparsec.Debug (dbg)
 
-import Text.Megaparsec.Char (eol, space1, string)
+import Text.Megaparsec.Char (char, eol, space1, string)
 import Text.Megaparsec.Char.Lexer qualified as L
 
 newtype Seeds = Seeds [Int]
@@ -12,35 +13,68 @@ newtype Seeds = Seeds [Int]
 
 -- | Parse a list of seeds
 --
--- >>> parseText pSeeds "seeds: 79 14 55 13"
+-- >>> parseText pSeeds "seeds: 79 14 55 13\n"
 -- Right [79,14,55,13]
 pSeeds :: Parser Seeds
-pSeeds = Seeds <$> (string "seeds: " *> L.decimal `sepBy1` ws)
+pSeeds = Seeds <$> (string "seeds: " *> (L.decimal `sepBy1` char ' ') <* eol)
 
-newtype Mapping = Mapping [((Int, Int), (Int, Int))]
+data Mapping = Mapping
+  { name :: Text
+  , indices :: [(Int, Int, Int)]
+  }
+  deriving stock (Show)
 
-pRanges :: Parser [((Int, Int), (Int, Int))]
+pRanges :: Parser [(Int, Int, Int)]
 pRanges = do
-  pRange `sepBy1` eol
+  some pRange
  where
-  pRange = do
+  pRange = Text.Megaparsec.try $ do
     x0 <- L.decimal <* space1
     x1 <- L.decimal <* space1
-    n <- L.decimal
-    pure ((x0, x0 + n), (x1, x1 + n))
+    n <- L.decimal <* eol
+    pure (x0, x1, n)
 
+-- | Parse an index mapping
+--
+-- >>> parseText pMapping "seed-to-soil map:\n50 98 2\n52 50 48\n"
+-- Right [(50,98,2),(52,50,48)]
 pMapping :: Parser Mapping
 pMapping = do
-  _ <-
+  name <-
     choice
-      [ string "soil-to-fertilizer map:"
-      , string "fertilizer-to-water map:"
-      , string "water-to-light map:"
-      , string "light-to-temperature map:"
-      , string "light-to-temperature map:"
+      [ string "seed-to-soil"
+      , string "soil-to-fertilizer"
+      , string "fertilizer-to-water"
+      , string "water-to-light"
+      , string "light-to-temperature"
+      , string "temperature-to-humidity"
+      , string "humidity-to-location"
       ]
+      <* string " map:"
       <* eol
-  Mapping . fromList <$> pRanges `sepBy1` eol
+  Mapping name <$> pRanges
+
+data Puzzle = Puzzle
+  { seeds :: Seeds
+  , mappings :: [Mapping]
+  }
+  deriving stock (Show)
+
+pPuzzle :: Parser Puzzle
+pPuzzle =
+  Puzzle <$> (pSeeds <* ws) <*> some (pMapping <* (void eol <|> eof))
 
 solve :: (MonadIO m) => Text -> m (Either Text Solution)
-solve _ = pure $ Left "not yet implemented"
+solve riddle = case parseText (pPuzzle <* eof) riddle of
+  Right puzzle ->
+    let
+      part1 :: Integer
+      part1 = genericLength (mappings puzzle)
+
+      part2 :: Integer
+      part2 = part1
+     in
+      do
+        print puzzle
+        pure $ Right [part1, part2]
+  Left e -> pure $ Left e