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

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

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

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

enumerate :: [a] -> [(Int, a)]
enumerate = zip [0..]

parseFile :: String -> ([Int], [[Int]])
parseFile = ((elemIndices 'S') *** (filter (not . null) . map (elemIndices '^'))) . fromJust . uncons . split ['\n']

solve1 :: ([Int], [[Int]]) -> Int
solve1 (xs, yss) = sum $ map fst $ scanl (\(_, xs') ys -> (sum *** (nub . concat)) $ unzip $ map (\x -> if x `elem` ys then (1, [x-1, x+1]) else (0, [x])) xs') (0, xs) yss

solve2 :: ([Int], [[Int]]) -> Int
solve2 (xs, yss) = sum $ map (\x -> (timelineArray yss) ! (x, 0)) xs

timelineArray :: [[Int]] -> Array (Int, Int) Int
timelineArray yss = fromFunc ((0, 0), (1 + (foldl max 0 $ map (foldl max 0) $ yss), length yss)) (uncurry timelines)
    where
  arr = timelineArray yss
  timelines x y
    | length yss <= y   = 1
    | x `elem` (yss!!y) = (arr ! (x-1, y+1)) + (arr ! (x+1, y+1))
    | otherwise         = arr ! (x, y+1)

fromFunc :: Ix i => (i, i) -> (i -> e) -> Array i e
fromFunc (a, b) f = array (a, b) [(x, f x) | x <- range (a, b)]

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