data Tree a = Empty | Node a (Tree a) (Tree a)
  deriving (Eq, Ord, Show)

leaf :: a -> Tree a
leaf x = Node x Empty Empty

tree = Node 5 (Node 6 (leaf 8) (leaf 9)) (Node 7 (leaf 10) (leaf 11))
treeList = [[1], [2, 3], [4, 5, 6], [7, 8, 9, 10]]
easyList = [[3], [7, 4], [2, 4, 6], [8, 5, 9, 3]]

infiniteTree :: Tree Char
infiniteTree = Node 'x' infiniteTree infiniteTree

-- breadth first traversal
bftrav :: Tree a -> [a]
bftrav = bftrav' . flip (:) []
  where
  bftrav' :: [Tree a] -> [a]
  bftrav' []                = []
  bftrav' (Empty:xs)        = bftrav' xs
  bftrav' ((Node x l r):xs) = x:bftrav' (xs ++ l:r:[])

-- breadth first numbering
bfnum :: Integral a => Tree b -> Tree a
bfnum t = t'
  where t':[] = bfnum' 1 [t]

bfnum' :: Integral a => a -> [Tree b] -> [Tree a]
bfnum' i []                = []
bfnum' i (Empty:xs)        = Empty:bfnum' i xs
bfnum' i ((Node x l r):xs) = (Node i l' r'):(reverse xs')
  where r':l':xs' = reverse $ bfnum' (i+1) (xs ++ l:r:[])
  --where xs':l':r' = bfnum' (i+1) (xs ++ l:r:[])

bfinsert' :: Maybe a -> [Tree a] -> [Tree a]
bfinsert' _ []                = []
bfinsert' (Just x) (Empty:ts) = (leaf x):bfinsert' Nothing ts
bfinsert' Nothing (Empty:ts)  = Empty:bfinsert' Nothing ts
bfinsert' x ((Node y l r):ts) = (Node y l' r'):(reverse ts')
  where r':l':ts' = reverse $ bfinsert' x (ts ++ l:r:[])

fromList :: [a] -> Tree a
fromList = head . foldl (flip bfinsert') [Empty] . map Just

parseToLists :: String -> [[Integer]]
parseToLists = map (map read . words) . lines

getLeft :: [[a]] -> [[a]]
getLeft = map init

getRight :: [[a]] -> [[a]]
getRight = map tail 

bfdepth :: [[a]] -> Tree a
bfdepth []          = Empty
bfdepth ((x:[]):xs) = Node x (bfdepth . getLeft $ xs) (bfdepth . getRight $ xs)

fromLists :: [[a]] -> Tree a
fromLists = bfdepth

easyTree = fromLists easyList

getPotential :: Integral a => Tree a -> a
getPotential Empty        = 0
getPotential (Node x l r) = x + max (getPotential l) (getPotential r)

getHeight :: Tree a -> Int
getHeight Empty        = 0
getHeight (Node _ t _) = 1 + getHeight t

maxLeft :: [[Integer]] -> [Integer]
maxLeft []     = []
maxLeft [x]    = [maximum x]
maxLeft (x:xs) = let ms = maxLeft xs in (maximum x + head ms):ms

type Current  = Integer
type MaxFound = Integer
type State    = (Current, MaxFound)

findMaxPath :: [Integer] -> State -> Tree Integer -> State
findMaxPath _ (c, m) (Node x Empty Empty) = if c + x > m then (c, c + x) else (c, m)
findMaxPath (p:ps) (c, m) (Node x l@(Node xl _ _) r@(Node xr _ _))
  | c + p <= m = (c, m)
  | otherwise  = (c, m'')
    where
    (_, m')  = (findMaxPath ps (c + x, m) l) 
    (_, m'') = if m' < c + p then 
                 if m' > m then (findMaxPath ps (c + x, m') r) else (findMaxPath ps (c + x, m) r)
                 else (c, m')


main = do
  s <- readFile "67.txt"
  let l = parseToLists s
  let t = fromLists l
  let m = maxLeft l
  let p = putStrLn . show
  p $ findMaxPath m (0, 0) t