ride.hs

leap ∷ Coor → Int2 → WithProblem Maybe Move
leap src dxy = do
   let dst = src ~+ dxy
   sqr ← squareAtM dst
   kind ← captureM $ colorOnSquare sqr
   return $ case kind of
      SimpleMove -> [ Relocate src dst ]
      CaptureMove -> [ Vacate dst, Relocate src dst ]

-- | linear movement by vector ij :: Int2
ride ∷ Coor → Int2 → WithProblem Identity [Move]
ride src@(Coor xy) ij = unfoldrM rideAdvance (xy +% ij)
   where
      -- | unfoldrM wants m (Maybe (a, b))
      rideAdvance ∷ Int2 → WithProblem Identity (Maybe (Move, Int2))
      rideAdvance z = mapReaderT (Identity . makePair) (leap src (z -% xy))
         where
            makePair ∷ Maybe Move → Maybe (Move, Int2)
            makePair = liftM (, z +% ij)  -- ^ tuple sections ahoy