module one

import StdEnv
import Data.Tuple
import Data.Either
import Data.Func
import Data.List
import Text => qualified join
import Data.Functor
import Control.Applicative
import Control.Monad
import Text.Parsers.Simple.ParserCombinators
from Data.Set import :: Set
import qualified Data.Set as DS

read :: *File -> [Char]
read f
	# (ok, c, f) = freadc f
	| not ok = []
	= [c:read f]

Start w
	# (io, w) = stdio w
	# (Right (fields, myticket, nearby)) = parse parseInput (read io)
	# nearby = filter (not o isEmpty) nearby
	= (one fields nearby, two fields myticket nearby)

one :: [([Char], [Int])] -> ([[Int]] -> Int)
one fields = sum o flatten o map (filter \e->not $ isMember e $ flatten $ map snd fields)

valid fields = isEmpty o filter \e->not $ isMember e $ flatten $ map snd fields

// for every ticket, for every field, every option
two :: [([Char], [Int])] [Int] [[Int]] -> Int
two fields myticket nearby
	// Translate to numbers and multiply
	= prod $ zipWith (\i [s]->if (startsWith ['departure'] s) i 1) myticket
	// iteratively find all singletons and apply constraint
	$ proc []
	// Transpose and merge all fieldconstraints
	$ map (\[x:xs]->foldr intersect x xs) $ transpose
	// Remove all invalid fields
	$ map (collectConstraints fields)
	// Remove all invalid tickets
	$ filter (valid fields) nearby
where
	collectConstraints :: [([Char], [Int])] [Int] -> [[[Char]]]
	collectConstraints fields fs = map collectConstraint fs
	where
		collectConstraint :: Int -> [[Char]]
		collectConstraint num = [f\\(f, rng)<-fields | isMember num rng]

	proc :: [[[Char]]] [[[Char]]] -> [[[Char]]]
	proc had [[x]:todo] = proc [[x]:map (filter ((<>)x)) had] $ map (filter ((<>)x)) todo
	proc had [x:todo] = proc [x:had] todo
	proc had [] = if (any ((<>) 1 o length) had) (proc [] had) had

parseInput :: Parser Char ([([Char], [Int])], [Int], [[Int]])
parseInput = tuple3 <$> many pField
	<* pStr ['\nyour ticket:\n'] <*> pSepBy pInt pComma <* pToken '\n'
	<* pStr ['\nnearby tickets:\n'] <*> pSepBy (pSepBy pInt pComma) (pToken '\n')
where
	pField :: Parser Char ([Char], [Int])
	pField = tuple <$> many (pSatisfy (\c->isAlpha c || c == ' ')) <* pStr [': '] <*> pRange <* pToken '\n'
	where
		pRange :: Parser Char [Int]
		pRange = flatten <$> pSepBy ((\x y->[x..y]) <$> pInt <* pToken '-' <*> pInt) (pStr [' or '])

	pInt :: Parser Char Int
	pInt = toInt o toString <$> some pDigit

	pStr :: ([Char] -> Parser Char [Char])
	pStr = sequence o map pToken