feat: documentation and box layout
This commit is contained in:
parent
cd5de79e24
commit
e1f2d5b5ef
6 changed files with 68 additions and 68 deletions
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue