1  import Data.Array.Unboxed
 2  import Data.Maybe
 3  import Text.Parsec
 4  
 5  type Pos = (Int, Int)
 6  
 7  type Dir = (Int, Int)
 8  
 9  type Grid = Array Pos Char
10  
11  wall = char '#' >> return "##"
12  
13  box = char 'O' >> return "[]"
14  
15  robot = do
16    pos <- getPosition
17    putState $ Just (sourceLine pos - 1, 2 * (sourceColumn pos - 1))
18    char '@'
19    return "@."
20  
21  open = char '.' >> return ".."
22  
23  tile = wall <|> box <|> open <|> robot
24  
25  up = char '^' >> return (-1, 0)
26  
27  right = char '>' >> return (0, 1)
28  
29  down = char 'v' >> return (1, 0)
30  
31  left = char '<' >> return (0, -1)
32  
33  instruction = up <|> down <|> left <|> right
34  
35  parseInput :: Parsec String (Maybe Pos) (Grid, [Dir], Pos)
36  parseInput = do
37    tiles <- (concat <$> many1 tile) `endBy` newline
38    newline
39    instructions <- concat <$> many1 instruction `endBy` newline
40    Just start <- getState
41    return (listArray ((0, 0), (length tiles - 1, length (tiles !! 0) - 1)) $ concat tiles, instructions, start)
42  
43  add2 (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
44  
45  move (grid, pos) dir = fromMaybe (grid, pos) $ do
46    pushed <- push pos dir grid
47    return (pushed, add2 pos dir)
48  
49  push pos dir grid =
50    case grid ! pos of
51      '#' -> Nothing
52      '.' -> Just grid
53      here | here == '@' || fst dir == 0 -> do
54        grid <- push into dir grid
55        return $ grid // [(pos, '.'), (into, here)]
56      '[' -> do
57        grid <- push into dir grid
58        grid <- push intobeside dir grid
59        return $ grid // [(pos, '.'), (beside, '.'), (into, '['), (intobeside, ']')]
60        where
61          beside = add2 pos (0, 1)
62          intobeside = add2 into (0, 1)
63      ']' -> do
64        grid <- push into dir grid
65        grid <- push intobeside dir grid
66        return $ grid // [(pos, '.'), (beside, '.'), (into, ']'), (intobeside, '[')]
67        where
68          beside = add2 pos (0, -1)
69          intobeside = add2 into (0, -1)
70    where
71      into = add2 pos dir
72  
73  gps (y, x) = 100 * y + x
74  
75  answer contents = sum $ fmap (gps . fst) . filter ((== '[') . snd) $ assocs $ fst $ foldl move (grid, start) instructions
76    where
77      Right (grid, instructions, start) = runParser parseInput Nothing "" contents
78  
79  main = getContents >>= print . answer