diff --git a/src/CHANGELOG.md b/src/CHANGELOG.md new file mode 100644 index 0000000..bedf9d1 --- /dev/null +++ b/src/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for Sudoku + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/src/LICENSE b/src/LICENSE new file mode 100644 index 0000000..d5b15c8 --- /dev/null +++ b/src/LICENSE @@ -0,0 +1,20 @@ +Copyright (c) 2024 Leon Vatthauer + +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: + +The above copyright notice and this permission notice shall be included +in all copies or substantial portions of the Software. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. +IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY +CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, +TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE +SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. diff --git a/src/Sudoku.cabal b/src/Sudoku.cabal new file mode 100644 index 0000000..55205fb --- /dev/null +++ b/src/Sudoku.cabal @@ -0,0 +1,130 @@ +cabal-version: 3.0 +-- The cabal-version field refers to the version of the .cabal specification, +-- and can be different from the cabal-install (the tool) version and the +-- Cabal (the library) version you are using. As such, the Cabal (the library) +-- version used must be equal or greater than the version stated in this field. +-- Starting from the specification version 2.2, the cabal-version field must be +-- the first thing in the cabal file. + +-- Initial package description 'Sudoku' generated by +-- 'cabal init'. For further documentation, see: +-- http://haskell.org/cabal/users-guide/ +-- +-- The name of the package. +name: Sudoku + +-- The package version. +-- See the Haskell package versioning policy (PVP) for standards +-- guiding when and how versions should be incremented. +-- https://pvp.haskell.org +-- PVP summary: +-+------- breaking API changes +-- | | +----- non-breaking API additions +-- | | | +--- code changes with no API change +version: 0.1.0.0 + +-- A short (one-line) description of the package. +-- synopsis: + +-- A longer description of the package. +-- description: + +-- The license under which the package is released. +license: MIT + +-- The file containing the license text. +license-file: LICENSE + +-- The package author(s). +author: Leon Vatthauer + +-- An email address to which users can send suggestions, bug reports, and patches. +-- maintainer: + +-- A copyright notice. +-- copyright: +category: Game +build-type: Simple + +-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README. +extra-doc-files: CHANGELOG.md + +-- Extra source files to be distributed with the package, such as examples, or a tutorial module. +-- extra-source-files: + +common warnings + ghc-options: -Wall + +library + -- Import common warning flags. + import: warnings + + -- Modules exported by the library. + exposed-modules: Types + + -- Modules included in this library but not exported. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: base ^>=4.18.2.0, + vector ^>=0.13.1.0, + mtl ^>=2.3.1 + + -- Directories containing source files. + hs-source-dirs: src + + -- Base language which the package is written in. + default-language: Haskell2010 + +executable Sudoku + -- Import common warning flags. + import: warnings + + -- .hs or .lhs file containing the Main module. + main-is: Main.hs + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- Other library packages from which modules are imported. + build-depends: + base ^>=4.18.2.0, + Sudoku + + -- Directories containing source files. + hs-source-dirs: app + + -- Base language which the package is written in. + default-language: Haskell2010 + +test-suite Sudoku-test + -- Import common warning flags. + import: warnings + + -- Base language which the package is written in. + default-language: Haskell2010 + + -- Modules included in this executable, other than Main. + -- other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + + -- The interface type and version of the test suite. + type: exitcode-stdio-1.0 + + -- Directories containing source files. + hs-source-dirs: test + + -- The entrypoint to the test suite. + main-is: Main.hs + + -- Test dependencies. + build-depends: + base ^>=4.18.2.0, + Sudoku diff --git a/src/app/Main.hs b/src/app/Main.hs new file mode 100644 index 0000000..12c9554 --- /dev/null +++ b/src/app/Main.hs @@ -0,0 +1,13 @@ +module Main where + +import Types + +main :: IO () +main = do + putStrLn "Reading:" + print (read test :: Sudoku) + putStrLn "Pretty Printing:" + putStrLn . pretty $ (read test :: Sudoku) + +test :: String +test = "070000043040009610800634900094052000358460020000800530080070091902100005007040802" \ No newline at end of file diff --git a/src/src/Types.hs b/src/src/Types.hs new file mode 100644 index 0000000..72dcedf --- /dev/null +++ b/src/src/Types.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE InstanceSigs #-} + +module Types where + +import Control.Monad.State (State) +import Data.Char (digitToInt, intToDigit) +import Data.Vector (Vector) + +-- * Stateful Sudoku Type + +data SudokuState = SudokuState + { dimension :: Int, + grid :: Vector Int, + idxs :: Vector (Int, Int) + } + +type SudokuMonad = State SudokuState + +getField :: (Int, Int) -> SudokuMonad Int +getField (x, y) = do + state <- get + return $ (x + y * dimension state) ! grid state + +getRow :: (Int, Int) -> SudokuMonad Int +getRow (x, _) = return x + +getCol :: (Int, Int) -> SudokuMonad Int +getCol (_, y) = return y + +getBox :: (Int, Int) -> SudokuMonad Int +getBox (x, y) = do + d <- gets dimension + let xPart = x `div` d + let yPart = y `div` d + return $ xPart + d * yPart + +-- * Stateless Sudoku Type + +-- + +-- $statelessFlattened +-- +-- Here we define a simpler Sudoku type that would be very inneficient to work with +-- but is suitable for pretty printing and reading + +-- | Contains metadata concerning a Sudoku field +data Sudoku = Sudoku + { -- | The dim of the Sudoku, e.g. a 9x9 Sudoku field has dim 3 + dim :: Int, + -- | The Sudoku field as a flattened list + grd :: [Int] + } + +instance Show Sudoku where + show :: Sudoku -> String + show = map intToDigit . grd + +instance Read Sudoku where + readsPrec :: Int -> ReadS Sudoku + readsPrec _ s = + if isInt dimDouble + then [(Sudoku (floor dimDouble) (map digitToInt s), "")] + else error ("Trying to parse malformed sudoku (number of digits [" ++ show (length s) ++ "] is not a quadratic root):\n" ++ s) + where + isInt x = x == fromInteger (round x) + dimDouble = sqrt . sqrt $ (fromIntegral (length s) :: Double) + +-- | Pretty printing of values. Analogous to the `Show` class, but does not harmonize with `Read`. +class Pretty a where + -- | Works like `show`, but is not inverse to `read`. + pretty :: a -> String + +-- TODO improve pretty printer, this is kind of a mess +instance Pretty Sudoku where + pretty :: Sudoku -> String + pretty s = prettyHelper (dim s - 1, dim s, grd s) + where + -- prettyBlock (isLast, n, list) + prettyBlock :: (Bool, Int, [Int]) -> String + prettyBlock (_, _, []) = "" + prettyBlock (True, n, _) | n == 0 = "" + prettyBlock (False, n, _) | n == 0 = "|" + prettyBlock (b, n, x : xs) = intToDigit x : ' ' : prettyBlock (b, n - 1, xs) + -- prettyRow (n, dim, list) + prettyRow :: (Int, Int, [Int]) -> String + prettyRow (n, dim, xs) | n == 0 = prettyBlock (True, dim, xs) + prettyRow (n, dim, xs) = prettyBlock (False, dim, xs) ++ (' ' : prettyRow (n - 1, dim, drop dim xs)) + -- prettyCol (isLast, n, dim, list) + prettyCol :: (Bool, Int, Int, [Int]) -> String + prettyCol (True, n, _, _) | n == 0 = "" + prettyCol (False, n, dim, _) | n == 0 = replicate (2 * dim * dim - 1 + 2 * (dim - 1)) '-' + prettyCol (_, _, _, []) = "" + prettyCol (b, n, dim, xs) = prettyRow (dim - 1, dim, xs) ++ ('\n' : prettyCol (b, n - 1, dim, drop (dim * dim) xs)) + -- prettyHelper (n, dim, list) + prettyHelper :: (Int, Int, [Int]) -> String + prettyHelper (n, dim, xs) | n == 0 = prettyCol (True, dim, dim, xs) + prettyHelper (n, dim, xs) = prettyCol (False, dim, dim, xs) ++ ('\n' : prettyHelper (n - 1, dim, drop (dim * dim) xs)) diff --git a/src/test/Main.hs b/src/test/Main.hs new file mode 100644 index 0000000..3e2059e --- /dev/null +++ b/src/test/Main.hs @@ -0,0 +1,4 @@ +module Main (main) where + +main :: IO () +main = putStrLn "Test suite not yet implemented."