module Day5 where
import System.IO
import ParseLib.Abstract
import Prelude hiding ((<*), (*>))
import Data.Char
import Data.List
import Data.Maybe

type Input = Int
type Output = Int
type Length = Int
data Range = Range Output Input Length deriving Show

type From = String
type To = String
data Map = Map From To [Range] deriving Show

main :: IO ()
main = do
    handle <- openFile "app/Day5-input.txt" ReadMode
    input <- hGetContents handle

    let (seeds, maps) = fst $ head $ parse parseInput input
        locations = map (applyTill maps "seed" "location") seeds

    putStr "Part 1: "
    print $ minimum locations

    let seeds' = concatMap range (pairs seeds)
        locations' = map (applyTill maps "seed" "location") seeds'

    putStr "Part 2: "
    print $ minimum locations'

    pure ()

whitespace = greedy (satisfy isSpace)
number = whitespace *> natural
parseInput = (,) <$> parseHeader <*> greedy parseMap
parseHeader = token "seeds: " *> greedy number <* whitespace
parseMap = Map <$> identifier <* token "-to-" <*> identifier <* token " map:\n" <*> greedy parseRange <* whitespace
parseRange = Range <$> number <*> number <*> number <* whitespace

apply :: [Map] -> From -> Input -> (To, Output)
apply ms f i = (t, applyMap m i)
    where
        m@(Map _ t _) = fromJust $ find (\(Map f' _ _) -> f' == f) ms

applyMap :: Map -> Input -> Output
applyMap (Map _ _ []) i' = i'
applyMap (Map f t ((Range o i l):rs)) i' 
    | i <= i' && i' <= i+l = o + (i' - i)
    | otherwise = applyMap (Map f t rs) i'

applyTill :: [Map] -> From -> To -> Input -> Output
applyTill ms f t i | t == t' = o
                   | otherwise = applyTill ms t' t o
    where (t', o) = apply ms f i

pairs [] = []
pairs (x1:x2:xs) = (x1,x2) : pairs xs

range (x,y) = [x..x+y-1]