Technically works

app/Main.hs

@@ -7,5 +7,5 @@ import System.Environment (getArgs)
 
 main :: IO ()
 main = getArgs >>= \case
-  [filename] -> readFile filename >>= print . parseStringToGrid
+  [filename] -> readFile filename >>= print . solve . parseStringToGrid
   _ -> error "Usage: Estinen filename"

fucky.sudoku

@@ -0,0 +1,9 @@
+1 2 3 4 5 X 7 8 9
+4 5 6 7 X 9 1 2 3
+7 8 9 1 2 X 4 5 6
+2 3 4 5 6 7 X 9 1
+5 6 7 8 9 X 2 3 4
+8 9 1 2 3 4 5 6 7
+6 7 8 9 1 2 3 4 5
+9 1 2 3 4 5 6 7 8
+3 4 5 6 7 8 9 1 2

src/Sudoku.hs

@@ -5,15 +5,19 @@ module Sudoku ( isValid
               , updateCell
               , emptyGrid
               , parseStringToGrid
+              , solve
+              , getSquare
               ) where
 
-import Data.Matrix hiding (getRow, getCol)
+import Data.Matrix hiding (getRow, getCol, trace)
 import Data.Matrix qualified as M
 import Data.Vector (Vector)
 import Data.Vector qualified as V
 import Data.Coerce
 import Control.Parallel
 import Control.Parallel.Strategies
+import Text.Printf
+import Data.List
 
 data Cell where
   One :: Cell
@@ -38,7 +42,7 @@ instance Show Cell where
   show Seven = "7"
   show Eight = "8"
   show Nine = "9"
-  show Unknown = " "
+  show Unknown = "_"
 
 cellFromChar :: String -> Cell
 cellFromChar "1" = One
@@ -60,8 +64,12 @@ newtype Column = Column (Vector Cell)
 newtype Row = Row (Vector Cell)
 -- Square is 3x3 
 newtype Square = Square (Matrix Cell)
+instance Show Square where
+  show (Square m) = prettyMatrix m
+
 -- Grid is 9x9
 newtype Grid = Grid (Matrix Cell)
+  deriving Eq
 
 instance Show Grid where
   show (Grid m) = prettyMatrix m
@@ -103,9 +111,9 @@ getColumn n
 
 getSquare :: Int -> Grid -> Square
 getSquare n
-  | n > 0 && n <= 9 = let !sr = (n+2) `div` 3
+  | n > 0 && n <= 9 = let !sr = ((n-1) `div` 3) * 3 + 1
                           !er = sr + 2
-                          !sc = (n+2) `mod` 3 + 1
+                          !sc = ((n-1) `mod` 3) * 3 + 1
                           !ec = sc + 2
                       in Square . submatrix sr er sc ec . coerce
   | otherwise       = error "Indexing square outside of grid"
@@ -127,5 +135,33 @@ updateCell n m
         coerce $ setElem c (n,m) mx else
         error "Updating non unkown value"
   | otherwise = error "Updating cell outside of grid"
-  
 
+leftToPlace :: Grid -> [Cell]
+leftToPlace =
+  V.toList .
+  (\v -> numbers >>= \i -> flip V.replicate i . (9-) . V.length $ V.elemIndices i v) .
+  getMatrixAsVector .
+  coerce
+
+findEmpty :: Grid -> [(Int,Int)]
+findEmpty = V.toList . ((\n -> ((n) `div` 9 + 1, n `mod` 9 + 1)) <$>) . V.findIndices (== Unknown) . getMatrixAsVector . coerce
+
+place :: Cell -> (Int,Int) -> Grid -> Grid
+place c pos g = coerce $ setElem c pos (coerce g)
+  
+solve :: Grid -> Grid
+solve g = let left = leftToPlace g in
+          case nub $ go g left of
+            []  -> error "No solution D:"
+            [x] -> x
+            xs   -> error (printf "%d solutions" $ length xs)
+  where go :: Grid -> [Cell] -> [Grid]
+        go g []     = if isValid g then pure g else mempty
+        go g (x:xs) = if not $ isValid g then mempty else
+          let empties = findEmpty g in
+            go' xs $ flip (x `place`) g <$> empties
+
+        go' :: [Cell] -> [Grid] -> [Grid]
+        go' _ [] = []
+        go' xs (g:gs) = let sol = go g xs in
+                          sol `par` go' xs gs <> sol

valid.sudoku

@@ -1,9 +1,9 @@
-1 2 3 4 5 6 X 8 9
+1 2 3 4 5 X 7 8 9
-2 X 4 5 6 X 8 X 1
+4 5 6 7 X 9 1 2 3
-3 4 5 X 7 8 9 1 2
+7 8 X 1 2 X 4 5 6
-4 5 6 7 8 X 1 2 3
+2 X 4 5 6 7 X 9 1
-5 X X 8 9 1 2 3 4
+5 6 X 8 9 X 2 3 4
-6 7 8 9 X 2 3 X X
+8 9 X 2 X 4 5 6 7
-7 X 9 1 2 3 X X X
+6 7 X 9 1 2 X 4 5
-8 9 1 X 3 4 5 6 X
+9 X 2 3 4 5 X X 8
-9 1 2 3 4 5 6 7 8
+3 4 5 6 7 8 X 1 2