Explore the possible paths in parallel. From the starting position, make all possible moves. Each of the resulting configurations can be reached in exactly one way. Then, from each of the resulting configurations, make all possible moves. Add the counts of the new configurations that can be reached from several of the previous configurations. Repeat that step until there is only one nonzero element in the grid. Cull impossible paths early.
For the bookkeeping which configuration can be reached in how many ways from the initial configuration, the easiest way is to use a Map. I chose to represent the grid as an (unboxed) array, since
- they are easier to handle for indexing and updating than lists of lists
- they use less space and indexing is faster
The code:
module Ways where
import qualified Data.Map.Strict as M
import Data.Array.Unboxed
import Data.List
import Data.Maybe
type Grid = UArray (Int,Int) Int
type Position = (Int,Int)
type Configuration = (Position, Grid)
type State = M.Map Configuration Integer
buildGrid :: [[Int]] -> Grid
buildGrid xss
    | null xss || maxcol == 0   = error "Cannot create empty grid"
    | otherwise = listArray ((1,1),(rows,maxcol)) $ pad cols xss
      where
        rows = length xss
        cols = map length xss
        maxcol = maximum cols
        pad (c:cs) (r:rs) = r ++ replicate (maxcol - c) 0 ++ pad cs rs
        pad _ _ = []
targets :: Position -> [Position]
targets (i,j) = [(i+d,j) | d <- [-2 .. 2], d /= 0] ++ [(i,j+d) | d <- [-2 .. 2], d /= 0]
moves :: Configuration -> [Configuration]
moves (p,g) = [(p', g') | p' <- targets p
                        , inRange (bounds g) p'
                        , g!p' > 0, let g' = g // [(p, g!p-1)]]
moveCount :: (Configuration, Integer) -> [(Configuration, Integer)]
moveCount (c,k) = [(c',k) | c' <- moves c]
step :: (Grid -> Bool) -> State -> State
step okay mp = foldl' ins M.empty . filter (okay . snd . fst) $ M.assocs mp >>= moveCount
  where
    ins m (c,k) = M.insertWith (+) c k m
iter :: Int -> (a -> a) -> a -> a
iter 0 _ x = x
iter k f x = let y = f x in y `seq` iter (k-1) f y
ways :: Position -> Position -> [[Int]] -> Integer
ways start end grid
    | any (< 0) (concat grid)   = 0
    | invalid   = 0
    | otherwise = fromMaybe 0 $ M.lookup target finish
      where
        ini = buildGrid grid
        bds = bounds ini
        target = (end, array bds [(p, if p == end then 1 else 0) | p <- range bds])
        invalid = not (inRange bds start && inRange bds end && ini!start > 0 && ini!end > 0)
        okay g = g!end > 0
        rounds = sum (concat grid) - 1
        finish = iter rounds (step okay) (M.singleton (start,ini) 1)