import Control.Monad

data Entry = Air | SandProduce | SandRest | Rock deriving Eq

type Grid = [[Entry]]
type Position = (Int, Int)
type Line = (Position, Position)
type Path = [Line]

drawPoint :: Entry -> Grid -> Position -> Grid
drawPoint e grid (x,y) = linesBefore++(entriesBefore++e:entriesAfter):linesAfter
         where (linesBefore,line:linesAfter) = splitAt y grid
               (entriesBefore, _:entriesAfter) = splitAt x line

range :: Int -> Int -> [Int]
range a b
  | a <= b = [a..b]
  | otherwise = range b a

drawLine :: Grid -> Line -> Grid
drawLine grid (from, to)
  | fst from == fst to = foldl (drawPoint Rock) grid [(fst from,y) | y<-range (snd from) (snd to)]
  | otherwise          = foldl (drawPoint Rock) grid [(x, snd from) | x<-range (fst from) (fst to)]

drawPath :: Grid -> Path -> Grid
drawPath = foldl drawLine

drawInput :: Grid -> [Path] -> Grid
drawInput = foldl drawPath

getXs, getYs :: Line -> [Int]
getXs ((x,_),(x',_)) = [x,x']
getYs ((_,y),(_,y')) = [y,y']

max_x, max_y :: Path -> Int
max_x = maximum.concatMap getXs
max_y = maximum.concatMap getYs

minGridFromInput paths = startGrid (mx+my) (my+3) 
                          where mx = maximum (map max_x paths)
                                my = maximum (map max_y paths)

startGrid width height = drawPoint SandProduce [[ Air | _<-[1..width]] | _ <- [1..height]] (500,0)

parsePosition :: String -> Position
parsePosition stringPosition = read $ '(':stringPosition ++ ")"

parseLine (x,y) = (parsePosition x,parsePosition y)

parsePath line = let w = words line in
                     map parseLine $ filter(/=("->","->")) $ zip w (drop 2 w)

entryToChar Air = '.';entryToChar Rock = '#';entryToChar SandProduce = '+';entryToChar SandFalling = '~';entryToChar SandRest = 'o'

printLine startx endx line = do
  let line' = take (endx - startx + 1) $ drop startx line
  forM line' (putChar.entryToChar)
  putChar '\n'

printGrid (startx,starty) (endx, endy) grid = do
  let grid' = take (endy - starty + 1) $ drop starty grid
  forM grid' $ printLine startx endx 

isAir (x,y) grid = grid !! y !! x == Air

nextSquare (x,y) grid
 | (y+1) >= length grid = Nothing
 | isAir (x,y+1) grid = nextSquare (x,y+1) grid
 | isAir (x-1,y+1) grid = nextSquare (x-1,y+1) grid
 | isAir (x+1,y+1) grid = nextSquare (x+1,y+1) grid
 | otherwise = Just (x,y)

nextSquare2 (x,y) grid
 | isAir (x,y+1) grid = nextSquare2 (x,y+1) grid
 | isAir (x-1,y+1) grid = nextSquare2 (x-1,y+1) grid
 | isAir (x+1,y+1) grid = nextSquare2 (x+1,y+1) grid
 | (x,y) == (500,0) = Nothing
 | otherwise = Just (x,y)

sandStep stepper grid = do
  newPoint <- stepper (500,0) grid
  pure $ drawPoint SandRest grid newPoint

doStep f n grid
  | (Just grid')<-sandStep f grid = doStep f (n+1) grid'
  | otherwise = (n, grid)

main = do
  grid <- readFile "day14long" >>= (\paths -> pure$drawInput (minGridFromInput paths) paths).map parsePath.lines
  let height = length grid
  let width = length (grid!!0)
  let grid2 = drawLine grid ((0,height-1),(width-1,height-1))
  let (n1,g1) = doStep nextSquare 0 grid
  let (n2,g2) = doStep nextSquare2 0 grid2
  print n1
  print $ 1+n2
  -- printGrid (460,0) (width-1, height-1) g2