diff --git a/.gitignore b/.gitignore index c368d45..be325ca 100644 --- a/.gitignore +++ b/.gitignore @@ -1,2 +1,3 @@ .stack-work/ -*~ \ No newline at end of file +*~ +data/ diff --git a/app/Main.hs b/app/Main.hs index 6eaf119..b76fea1 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -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 "" 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 + diff --git a/solvedoku.cabal b/solvedoku.cabal index 0565f04..822ae49 100644 --- a/solvedoku.cabal +++ b/solvedoku.cabal @@ -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 -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 diff --git a/src/Graphics/Text/Box.hs b/src/Graphics/Text/Box.hs index c7ede68..ff6d1c1 100644 --- a/src/Graphics/Text/Box.hs +++ b/src/Graphics/Text/Box.hs @@ -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 diff --git a/src/Sudoku/Area.hs b/src/Sudoku/Area.hs index 09d0c96..3a47b24 100644 --- a/src/Sudoku/Area.hs +++ b/src/Sudoku/Area.hs @@ -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 + diff --git a/test/example.s3 b/test/example.s3 deleted file mode 100644 index 98cbd6b..0000000 --- a/test/example.s3 +++ /dev/null @@ -1,9 +0,0 @@ -003020600 -900305001 -001806400 -008102900 -700000008 -006708200 -002609500 -800203009 -005010300