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

3
.gitignore vendored
View file

@ -1,2 +1,3 @@
.stack-work/
*~
*~
data/

View file

@ -6,7 +6,7 @@ import qualified Sudoku
import qualified Sudoku.Solve as Solve
import qualified Sudoku.Render as Render
import Sudoku.State (State)
import Options.Applicative (subparser, command, info, Parser, progDesc, execParser)
import Options.Applicative (subparser, command, info, Parser, progDesc, execParser, idm, customExecParser, ParserPrefs, showHelpOnEmpty, prefs)
import System.Exit (exitFailure)
data Mode
@ -21,7 +21,7 @@ parseMode = subparser
main :: IO ()
main = do
mode <- execParser (info parseMode mempty)
mode <- customExecParser optparsePreferences (info parseMode idm)
input <- Text.getContents
sudoku <- case runParser Sudoku.parse "<stdin>" input of
Left errorBundle -> (Text.putStr . Text.pack . errorBundlePretty $ errorBundle) >> exitFailure
@ -34,3 +34,6 @@ main = do
in Render.hints hints
optparsePreferences :: ParserPrefs
optparsePreferences = prefs showHelpOnEmpty

View file

@ -1,4 +1,4 @@
cabal-version: 2.2
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.38.1.
--
@ -7,22 +7,15 @@ cabal-version: 2.2
name: solvedoku
version: 0.1.0.0
description: Please see the README on GitHub at <https://github.com/githubuser/solvedoku#readme>
homepage: https://github.com/githubuser/solvedoku#readme
bug-reports: https://github.com/githubuser/solvedoku/issues
author: Author name here
maintainer: example@example.com
copyright: 2025 Author name here
license: BSD-3-Clause
license-file: LICENSE
author: VegOwOtenks
maintainer: vegowotenks@jossco.de
copyright: 2025 VegOwOtenks
license: AGPL-3.0
build-type: Simple
extra-source-files:
README.md
CHANGELOG.md
source-repository head
type: git
location: https://github.com/githubuser/solvedoku
library
exposed-modules:
Data.Enum.Util
@ -38,8 +31,6 @@ library
Sudoku.Triple
other-modules:
Paths_solvedoku
autogen-modules:
Paths_solvedoku
hs-source-dirs:
src
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
@ -59,8 +50,6 @@ executable solvedoku-exe
main-is: Main.hs
other-modules:
Paths_solvedoku
autogen-modules:
Paths_solvedoku
hs-source-dirs:
app
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
@ -82,8 +71,6 @@ test-suite solvedoku-test
main-is: Spec.hs
other-modules:
Paths_solvedoku
autogen-modules:
Paths_solvedoku
hs-source-dirs:
test
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N

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

View file

@ -1,9 +0,0 @@
003020600
900305001
001806400
008102900
700000008
006708200
002609500
800203009
005010300