import Prelude
import Data.List.Split (splitOn)
import qualified Data.Map.Lazy as M
import Data.Map.Lazy ((!))
import GHC.IO (unsafePerformIO)
import Control.DeepSeq (deepseq)

data Tile = Wall | Sand
  deriving (Eq)

instance Show Tile where
  show Wall = "#"
  show Sand = "o"

type Pos = (Int, Int)
type Grid a = M.Map Pos a

(!!!) :: Grid a -> Pos -> a
(!!!) = (!)

-- parsing time...

writeWall :: Grid Tile -> [Pos] -> Grid Tile
writeWall startGrid positions = snd $ foldl (\(oldPos, grid) newPos -> (newPos, writeWall' grid (oldPos, newPos))) (head positions, startGrid) positions
  where
    writeWall' :: Grid Tile -> (Pos, Pos) -> Grid Tile
    writeWall' grid ((x1, y1), (x2, y2)) = grid `M.union` wallsGrid
      where
        wallsGrid = M.fromList $ concatMap (\y -> map (\x -> ((x, y), Wall)) [minX .. maxX]) [minY .. maxY]
        minX = min x1 x2
        minY = min y1 y2
        maxX = max x1 x2
        maxY = max y1 y2

writeWalls :: [[Pos]] -> Grid Tile
writeWalls = foldl writeWall M.empty

parsePos :: String -> Pos
parsePos p = (read $ split !! 0, read $ split !! 1)
  where split = splitOn "," p

parseWall :: String -> [Pos]
parseWall = map parsePos . splitOn " -> "

{-# NOINLINE debug #-}
debug :: Show a => a -> ()
debug = unsafePerformIO . print

trace :: Show b => b -> a -> a
trace s = deepseq (debug s)

sandPos = (500, 0)

dropSand :: Grid Tile -> Maybe (Grid Tile)
dropSand grid = case sandGrain of
  (Just pos) -> Just $ grid `M.union` M.singleton pos Sand
  Nothing -> Nothing
  where
    sandGrain = resolveSand sandPos
    groundY = maxY + 2
    maxY = maximum $ map snd $ M.keys $ M.filter (== Wall) grid

    resolveSand :: Pos -> Maybe Pos
    resolveSand (x, y)
      | y >= (groundY - 1) = Just (x, y)
      | null validPositions && (x, y) == sandPos = Nothing
      | null validPositions = Just (x, y)
      | otherwise = resolveSand $ head validPositions
      where
        validPositions = filter (not . (`M.member` grid)) [(x, y + 1), (x - 1, y + 1), (x + 1, y + 1)]

repeatUntilNothing :: (a -> Maybe a) -> a -> a -> a
repeatUntilNothing f previous input = case f input of
  Just x -> repeatUntilNothing f input x
  Nothing -> previous

main = interact $
  show
  . (+ 2) . length . M.filter (== Sand)
  . (\grid -> repeatUntilNothing dropSand grid grid)
  . writeWalls
  . map parseWall . lines