import Data.List
import Data.Ord
import Data.Array
import Data.Array.MArray
import Data.Array.ST
import Control.Monad
import Control.Monad.ST

main :: IO ()
main = do
  input <- readFile "input"
  let grid = makeGrid (lines input)
  let (sy,sx) = head (findOnGrid grid 'S')
  let end = head (findOnGrid grid 'E')
--  print $ part1 grid (sy,sx,East) end
  print $ part2 grid (sy,sx,East) end

data Dir = North | East | South | West deriving (Eq, Ord, Enum, Bounded, Show, Ix)

getDir North = (-1,0)
getDir East = (0,1)
getDir South = (1,0)
getDir West = (0,-1)
flipDir North = South
flipDir South = North
flipDir West = East
flipDir East = West

maxInt = maxBound :: Int

part2 grid start (ey,ex) =
  let dist = findDistances grid start
      end = minimumBy (comparing (dist!)) [(ey,ex,d) | d <- [North .. West]]
      shortest = findShortest grid dist end
      pathTiles = nub . map (\(y,x,d) -> (y,x)) . concat $ shortest
  in length pathTiles

--findShortest :: Grid -> Array (Int,Int,Dir) Int -> (Int,Int,Dir) -> [[(Int,Int,Dir)]]
findShortest grid dist pos
  | dist!pos == 0 = [[pos]]
  | otherwise = let neighbours = getNeighboursBack grid pos
                    next = map fst $ filter (\(p,c) -> dist!p + c == dist!pos) neighbours
                in map (pos:) $ concatMap (findShortest grid dist) next

part1 grid start (ey,ex) =
  let dist = findDistances grid start
  in minimum $ map (\d -> dist!(ey,ex,d)) [North .. West]

-- dijkstra algorithm
findDistances :: Array (Int,Int) Char -> (Int,Int,Dir) -> Array (Int,Int,Dir) Int
findDistances grid start = runST $ do
    let ((miny,minx), (maxy,maxx)) = bounds grid
    dist <- newArray ((miny,minx,North), (maxy,maxx,West)) maxInt :: ST s (STArray s (Int,Int,Dir) Int)
    writeArray dist start 0
    search dist [start]
    frozen <- freeze dist
    return frozen
  where search dist [] = return ()
        search dist current = do
          let neighbours = concatMap (getFromTo grid) current
          next <- forM neighbours $ \(from, to, cost) -> do
            hereDist <- readArray dist from
            oldDist <- readArray dist to
            let newDist = hereDist + cost
            if newDist < oldDist then do
              writeArray dist to newDist
              return [to]
            else return []
          search dist (concat next)

addPair (a,b) (c,d) = (a+c,b+d)

getFromTo grid pos = map (\(p,c) -> (pos, p, c)) $ getNeighbours grid pos


getNeighboursBack grid (i,j,d) =
  let turns = [((i,j,dir),1000) | dir <- [North .. West], dir /= d]
      (fy,fx) = addPair (i,j) (getDir (flipDir d))
  in if grid!(fy,fx) == '#' then turns
     else ((fy,fx,d),1):turns

getNeighbours grid (i,j,d) =
  let turns = [((i,j,dir),1000) | dir <- [North .. West], dir /= d]
      (fy,fx) = addPair (i,j) (getDir d)
  in if grid!(fy,fx) == '#' then turns
     else ((fy,fx,d),1):turns

findOnGrid grid char = map fst . filter ((== char) . snd) . assocs $ grid

type Grid = Array (Int,Int) Char
makeGrid grid = array bounds elements
  where n = length grid
        m = length (head grid)
        bounds = ((0,0), (n-1,m-1))
        elements = [((i,j), (grid!!i!!j)) |
                    i <- [0..n-1], j <- [0..m-1]]