module AoC.Y2023.D05 where

import AoC.Parser
import AoC.Riddle
import Text.Megaparsec (choice, eof, sepBy, sepBy1, someTill, try)
import Text.Megaparsec.Debug (dbg)

import Text.Megaparsec.Char (char, eol, space1, string)
import Text.Megaparsec.Char.Lexer qualified as L

newtype Seeds = Seeds [Int]
  deriving newtype (Show)

-- | Parse a list of seeds
--
-- >>> parseText pSeeds "seeds: 79 14 55 13\n"
-- Right [79,14,55,13]
pSeeds :: Parser Seeds
pSeeds = Seeds <$> (string "seeds: " *> (L.decimal `sepBy1` char ' ') <* eol)

data Mapping = Mapping
  { name :: Text
  , indices :: [(Int, Int, Int)]
  }
  deriving stock (Show)

pRanges :: Parser [(Int, Int, Int)]
pRanges = do
  some pRange
 where
  pRange = Text.Megaparsec.try $ do
    x0 <- L.decimal <* space1
    x1 <- L.decimal <* space1
    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 "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 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 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