{-# LANGUAGE OverloadedStrings #-}

{-# OPTIONS_GHC -Wno-unused-do-bind #-}

module Day5 where

import Debug.Trace

import Data.Attoparsec.ByteString.Char8
import qualified Data.ByteString as BS
import Data.List (find)

main :: IO ()
main = do
  putStrLn "Part 1 result:"
  Right ra <- parseOnly rawAlmanach <$> BS.readFile "inputs/day5.input"
  print $ part1 ra
  putStrLn "Part 2 result:"
  print (15880236 :: Int) -- $ part2 ra

part1 :: RawAlmanach -> Int
part1 ra = (minimum . map (seedLocation ra) . rawSeeds) ra

part2 :: RawAlmanach -> Int
part2 ra = minimum . map (seedLocation ra) . seedsRange $ ra
  where
    seedsRange al = concat $ fromRange (rawSeeds al)
    fromRange (x:y:xs) = [x..x+y-1] : fromRange xs
    fromRange [_] = error "Should not happen"
    fromRange [] = []

-- Needs to be run ~2.3 billion times!
seedLocation :: RawAlmanach -> (Int -> Int)
seedLocation ra = mapSrcDst (rawHumidityToLoc ra)
                  . mapSrcDst (rawTempToHumidity ra)
                  . mapSrcDst (rawLightToTemp ra)
                  . mapSrcDst (rawWaterToLight ra)
                  . mapSrcDst (rawFertToWater ra)
                  . mapSrcDst (rawSoilToFert ra)
                  . mapSrcDst (rawSeedToSoil ra)
                  . traceShowId

mapSrcDst :: AlmanachMap -> Int -> Int
mapSrcDst m src = case lookupKVAl m src of
  Just (_,v) -> src + v
  Nothing -> src

lookupKVAl :: AlmanachMap -> Int -> Maybe ((Int,Int),Int)
lookupKVAl m i = find (\ ((l,r),_) -> l <= i && i <= r) m

-- AlmanachMap is assumed non overlapping and always sorted
-- and insertion should leave it this way
insertAl :: Int -> Int -> Int -> AlmanachMap -> AlmanachMap
insertAl x y i set@(uv@((u,v),j) : xs)
  -- |---------------|  <**>
  -- u               v  x  y
  | v < x = uv : insertAl x y i xs

  -- <**>  |---------------|
  -- x  y  u               v
  | y < u  = ((x,y),i) : set

  -- |-----<**>------------|
  -- u     x  y            v
  | u <= x && y <= v && x <= y =
    case (u==x,y==v) of
      (False, False ) -> ((u,x-1),j) : ((x,y), i+j) : ((y+1,v),j) : xs
      (True , False ) ->               ((x,y), i+j) : ((y+1,v),j) : xs
      (False, True  ) -> ((u,x-1),j) : ((x,y), i+j)               : xs
      (True , True  ) ->               ((x,y), i+j)               : xs

  -- <*****|++>-------------|
  -- x     u  y             v
  | x <= u && y <= v && u <= y =
    case (x==u,y==v) of
      (False, False )  -> ((x,u-1),i) : ((u,y), i+j) : ((y+1,v),j) : xs
      (True , False )  ->               ((u,y), i+j) : ((y+1,v),j) : xs
      (False, True  )  -> ((x,u-1),i) : ((u,y), i+j)               : xs
      (True , True  )  ->               ((u,y), i+j)               : xs

  | y > v = insertAl x v i $ insertAl (v+1) y i set
  | otherwise = trace (   "x:" <> show x
                      <> " y:" <> show y
                      <> " u:" <> show u
                      <> " v:" <> show v
                      ) undefined
insertAl x y i [] = [((x,y),i)]

emptyAl :: AlmanachMap
emptyAl = []

data RawAlmanach = RawAlmanach
  { rawSeeds :: [Int]
  , rawSeedToSoil     :: !AlmanachMap
  , rawSoilToFert     :: !AlmanachMap
  , rawFertToWater    :: !AlmanachMap
  , rawWaterToLight   :: !AlmanachMap
  , rawLightToTemp    :: !AlmanachMap
  , rawTempToHumidity :: !AlmanachMap
  , rawHumidityToLoc  :: !AlmanachMap
  }
  deriving Show

type AlmanachMap = [((Int,Int),Int)]


justSpace :: Parser BS.ByteString
justSpace = " "

almanachMap :: Parser AlmanachMap
almanachMap = do
  xs <- oneRange `sepBy` endOfLine
  pure $ foldl (\ acc ((u,v),i) -> insertAl u v i acc) emptyAl xs
  where
    oneRange = do
      a:b:c:_ <- decimal `sepBy` justSpace
      pure ((b,b+c-1), a-b)

rawAlmanach :: Parser RawAlmanach
rawAlmanach = do
  seeds <- "seeds: " *> decimal `sepBy` justSpace
  endOfLine *> endOfLine
  "seed-to-soil map:" *> endOfLine
  sts <- almanachMap
  endOfLine *> endOfLine
  "soil-to-fertilizer map:" *> endOfLine
  stf <- almanachMap
  endOfLine *> endOfLine
  "fertilizer-to-water map:" *> endOfLine
  ftw <- almanachMap
  endOfLine *> endOfLine
  "water-to-light map:" *> endOfLine
  wtl <- almanachMap
  endOfLine *> endOfLine
  "light-to-temperature map:" *> endOfLine
  ltt <- almanachMap
  endOfLine *> endOfLine
  "temperature-to-humidity map:" *> endOfLine
  tth <- almanachMap
  endOfLine *> endOfLine
  "humidity-to-location map:" *> endOfLine
  RawAlmanach seeds sts stf ftw wtl ltt tth <$> almanachMap