feat: documentation and box layout

This commit is contained in:
vegowotenks 2025-07-18 18:05:38 +02:00
parent cd5de79e24
commit e1f2d5b5ef
6 changed files with 68 additions and 68 deletions

View file

@ -16,6 +16,8 @@ import qualified Data.Foldable as Foldable
import Control.Arrow (Arrow ((***)))
import qualified Data.Text as Text
-- | A box of text. Has rectangular size, queried with 'size'.
data Box
= Raw (Array (Int, Int) Char)
| Grid (Array (Int, Int) Box) (Maybe Border)
@ -23,6 +25,16 @@ data Box
data Border = Border
{ top, right, left, bottom, topRight, bottomRight, bottomLeft, topLeft, crosssection, verticalBetween, horizontalBetween :: Char }
-- | Draw grids like this:
--
-- @
-- \/---\
-- | | |
-- |-+-|
-- | | |
-- \\---/
-- @
asciiBorder :: Border
asciiBorder = Border {top='-', right='|', left='|', bottom='-', topRight='\\', bottomRight='/', bottomLeft='\\', topLeft='/', crosssection='+', verticalBetween='|', horizontalBetween='-'}
@ -32,6 +44,8 @@ type Column = Int
square :: Int -> ((Row, Column) -> Char) -> Box
square dim f = Raw $ genArray ((0, 0), (dim - 1, dim - 1)) f
-- | All fields will be laid out like in a static grid. There is no compensation for differently sized Boxes in different rows.
grid :: Maybe Border -> (Int, Int) -> ((Int, Int) -> Box) -> Box
grid border (rows, cols) f = let
@ -39,6 +53,8 @@ grid border (rows, cols) f = let
in Grid boxes border
-- | Use the 'asciiBorder'.
asciiGrid :: (Int, Int) -> ((Int, Int) -> Box) -> Box
asciiGrid = grid $ Just asciiBorder
@ -47,6 +63,8 @@ gridCellSize = let
updateMaxSize box (height, width) = (max height *** max width) $ size box
in Foldable.foldr updateMaxSize (0, 0)
-- | The rectangular size of the box.
size :: Box -> (Int, Int)
size = \case
Raw chars -> arraySize chars -- snd takes the higher bound, +1 because the array has inclusive ranges
@ -66,13 +84,15 @@ arraySize = join bimap (+1) . snd . Array.bounds
orElse :: Maybe a -> a -> a
orElse option x = Maybe.fromMaybe x option
-- | Look at a single character in the box.
lookup :: Box -> (Int, Int) -> Maybe Char
lookup b index@(row, col) = case b of
Raw chars -> chars Array.!? index
Grid boxes borderM -> let
(boxRows, boxColumns) = arraySize boxes
(boxHeight, boxWidth) = gridCellSize boxes
(totalHeight, totalWidth) = size b
in case borderM of
@ -83,33 +103,27 @@ lookup b index@(row, col) = case b of
innerBox <- boxes Array.!? (boxRow, boxCol)
lookup innerBox (boxRowIndex, boxColIndex)
Just border -> if
| row == 0 && col == 0 -> Just border.topLeft
| row == 0 -> Just border.top
| col == 0 -> Just border.left
-- ^ outer border cases are easy
| otherwise -> let
row' = row - 1
col' = col - 1
(boxRow, boxRowIndex) = row' `divMod` (boxHeight + 1)
(boxCol, boxColIndex) = col' `divMod` (boxWidth + 1)
Just border -> let
(boxRow, boxRowIndex) = pred row `divMod` (boxHeight + 1)
(boxCol, boxColIndex) = pred col `divMod` (boxWidth + 1)
in if
| boxRowIndex == boxHeight && boxColIndex == boxWidth -> Just $
if boxRow == boxRows - 1 && boxCol == boxColumns - 1 -- is it the last row and col?
then border.bottomRight
else border.crosssection
| boxRowIndex == boxHeight -> Just $
if boxRow == boxRows - 1 -- is it the last row?
then border.bottom
else border.horizontalBetween
| boxColIndex == boxWidth -> Just $
if boxCol == boxColumns - 1 -- is it the last column?
then border.right
else border.verticalBetween
| otherwise -> do -- it's not at the border between boxes at all
innerBox <- boxes Array.!? (boxRow, boxCol)
lookup innerBox (boxRowIndex, boxColIndex)
in if
| row == 0 && col == 0 -> Just border.topLeft
| col == 0 && row == totalHeight - 1 -> Just border.bottomLeft
| row == 0 && col == totalWidth - 1 -> Just border.topRight
| row == totalHeight - 1 && col == totalWidth - 1 -> Just border.bottomRight
| row == 0 -> Just border.top
| row == totalHeight - 1 -> Just border.bottom
| col == 0 -> Just border.left
| col == totalWidth - 1 -> Just border.right
| boxRowIndex == boxHeight && boxColIndex == boxWidth -> Just border.crosssection
| boxRowIndex == boxHeight -> Just border.horizontalBetween
| boxColIndex == boxWidth -> Just border.verticalBetween
| otherwise -> do
innerBox <- boxes Array.!? (boxRow, boxCol)
lookup innerBox (boxRowIndex, boxColIndex)
-- | Render everything inside, recursively. Produces a rectangular string with line-breaks.
render :: Box -> Text
render box = let

View file

@ -3,7 +3,7 @@
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE DeriveTraversable #-}
module Sudoku.Area (Area(..), indexFromDigit) where
module Sudoku.Area (Area(..), indexFromDigit, digitFromIndex) where
import Sudoku.Triple (Triple, Index)
import Data.Functor.Compose (Compose(..))
@ -20,18 +20,10 @@ instance Distributive Area where
distribute :: Functor f => f (Area a) -> Area (f a)
distribute = Area . distribute . fmap get
indexFromDigit :: Int -> (Index, Index)
indexFromDigit i = join bimap toEnum $ i `divMod` 3
digitFromIndex :: (Index, Index) -> Int
digitFromIndex (outer, inner) = fromEnum outer * 3 + fromEnum inner
-- | Accepts arguments from `0` to `8`. Everything else fails with 'error'
--
-- prop> \ i -> digitFromIndex (indexFromDigit (i `mod` 9)) == i `mod` 9
-- +++ OK, passed 100 tests.
-- >>> import Sudoku.Triple (Index(..))
-- >>> digitFromIndex (First, First)
-- 0
--
-- >>> indexFromDigit 9
-- *** Exception: Enum.toEnum{Index}: tag (3) is outside of enumeration's range (0,2)
@ -39,3 +31,15 @@ digitFromIndex (outer, inner) = fromEnum outer * 3 + fromEnum inner
-- >>> indexFromDigit 6
-- (Third,First)
indexFromDigit :: Int -> (Index, Index)
indexFromDigit i = join bimap toEnum $ i `divMod` 3
-- | Inverse of 'indexFromDigit'
--
-- >>> import Sudoku.Triple (Index(..))
-- >>> digitFromIndex (First, First)
-- 0
digitFromIndex :: (Index, Index) -> Int
digitFromIndex (outer, inner) = fromEnum outer * 3 + fromEnum inner