spirals.hs

import Control.Monad
import Control.Monad.State
import Data.Sequence as Seq
import Data.Foldable (toList)
import Debug.Trace
import Data.Maybe
import Text.Printf

data Direction = East | South | West | North
nextDirection :: Direction -> Direction
nextDirection East = South
nextDirection South = West
nextDirection West = North
nextDirection North = East

type Board = Seq.Seq (Seq.Seq (Maybe Int))

-- Y=H X=W
nextCell :: (Int, Int, Direction) -> Board -> (Int, Int, Direction)
nextCell (y, x, dir) b = go y x dir
                    where nextY y South = y + 1
                          nextY y North = y - 1
                          nextY y _ = y

                          nextX x West = x - 1
                          nextX x East = x + 1
                          nextX x _ = x

                          go y x dir = let y' = nextY y dir
                                           x' = nextX x dir
                                       in case indexAt b y' x' of
                                             Just Nothing -> (y', x', dir) -- There's a cell, and it's empty -> same dir
                                             _            -> go y x $ nextDirection dir


safeIndex :: Seq.Seq a -> Int -> Maybe a
safeIndex xs i = if i >= 0 && i < Seq.length xs
                 then Just $ Seq.index xs i
                 else Nothing

indexAt :: Board -> Int -> Int -> Maybe (Maybe Int)
indexAt board y x = safeIndex board y >>= \xs -> safeIndex xs x

genBoard :: Int -> Int -> (Seq.Seq (Seq.Seq (Maybe Int)))
genBoard h w = filledBoard -- sequence $ fmap sequence filledBoard
             where max = w * h
                   emptyBoard = Seq.replicate h $ Seq.replicate w Nothing
                   fillCell cell i board =
                        if i == max
                        then board
                        else let newBoard = updateAt board cell i
                             in fillCell (nextCell cell newBoard) (i + 1) (trace (showBoard newBoard) newBoard)
                   updateAt :: Board -> (Int, Int, Direction) -> Int -> Board
                   updateAt board (y, x, _) value = Seq.adjust (Seq.update x $ Just value) y board
                   filledBoard = fillCell (0, 0, East) 0 emptyBoard

showBoard :: Seq.Seq (Seq.Seq (Maybe Int)) -> String
showBoard board = concat $ toList $ showLine <$> board
                where showLine :: Seq.Seq (Maybe Int) -> String
                      showLine = (++ "\n") . concat . toList . fmap showCell

                      showCell :: Maybe Int -> String
                      showCell = fromMaybe "  ?" . fmap (printf "%3d")

main :: IO ()
main = putStrLn $ show $ genBoard 5 5