import Debug.Trace
import Data.Maybe
import Data.List

(***) :: (a -> a') -> (b -> b') -> (a, b) -> (a', b')
(f *** g) (x, y) = (f x, g y)

(&&&) :: (a -> b) -> (a -> c) -> a -> (b, c)
(f &&& g) x = (f x, g x)

infixr 3 ***
infixr 3 &&&

traceOut :: Show a => a -> a
traceOut x = traceShow x x

addFirst :: [[a]] -> a -> [[a]]
addFirst [] x = [[x]]
addFirst (y:ys) x = (x : y) : ys

split :: Eq a => [a] -> [a] -> [[a]]
split _ [] = []
split delims (x:xs)
  | x `elem` delims = [] : split delims xs
  | otherwise       = addFirst (split delims xs) x

parseFile :: String -> ([(Int, Int)], [Int])
parseFile = (map (read *** read . drop 1) . map (break (=='-')) *** map read . drop 1) . break (=="") . split ['\n']

elemRange :: (Int, Int) -> Int -> Bool
elemRange (x, y) z = x <= z && z <= y

solve1 :: ([(Int, Int)], [Int]) -> Int
solve1 (xs, ys) = length $ filter id $ map (\y -> foldl (||) False $ map (`elemRange` y) xs) ys

joinRanges :: [(Int, Int)] -> Maybe (Int, Int)
joinRanges [] = Nothing
joinRanges xs = Just $ (foldl1 min . map fst &&& foldl1 max . map snd) xs

rangesIntersect :: (Int, Int) -> (Int, Int) -> Bool
rangesIntersect (p, q) (r, s) = (p <= r && r <= q) || (p <= s && s <= q) || (r <= p && p <= s)

mergeRanges :: [(Int, Int)] -> (Int, Int) -> [(Int, Int)]
mergeRanges xs y = (fromJust $ joinRanges $ y : merge) : noMerge
    where (merge, noMerge) = partition (rangesIntersect y) xs    

solve2 :: ([(Int, Int)], [Int]) -> Int
solve2 = sum . map (\(a, b) -> b-a+1) . foldl mergeRanges [] . fst

main = do 
    fileinp <- readFile "input.txt"
    let input = parseFile fileinp
    let solved1 = solve1 input
    let solved2 = solve2 input
    print solved1
    print solved2