Simplifies solve

src/Sudoku.hs

@@ -1,6 +1,6 @@
 module Main where
 
-import qualified Control.Applicative
+import Control.Applicative ((<|>))
 import qualified Control.Monad
 import qualified Data.Char
 import qualified Data.Function
@@ -64,54 +64,60 @@ pruneGrid = fixM pruneGrid'
   where
     fixM f x = f x >>= \x' -> if x' == x then return x else fixM f x'
 
+isFinishedGrid :: Grid -> Bool
+isFinishedGrid grid = null [ () | Possible _ <- concat grid ]
+
 isInvalidGrid :: Grid -> Bool
 isInvalidGrid grid =
   any isInvalidRow grid
   || any isInvalidRow (Data.List.transpose grid)
   || any isInvalidRow (subGridsToRows grid)
   where
-    isInvalidRow = not . isValidRow
+    isInvalidRow row =
-    isValidRow row =
       let fixeds         = [x | Fixed x <- row]
           emptyPossibles = [x | Possible x <- row, null x]
-      in length fixeds == length (Data.List.nub fixeds) && null emptyPossibles
+      in hasDups fixeds || not (null emptyPossibles)
 
-isFinishedGrid :: Grid -> Bool
+    hasDups l = hasDups' l []
-isFinishedGrid grid = null [ () | Possible _ <- concat grid ]
+
+    hasDups' [] _ = False
+    hasDups' (y:ys) xs
+      | y `elem` xs = True
+      | otherwise   = hasDups' ys (y:xs)
 
 solve :: Grid -> Maybe Grid
-solve grid
+solve grid = pruneGrid grid >>= solve'
-  | isInvalidGrid grid  = Nothing
+  where
-  | isFinishedGrid grid = Just grid
+    solve' grid
-  | otherwise         =
+      | isInvalidGrid grid  = Nothing
-      let (grid1, grid2) = splitGrid
+      | isFinishedGrid grid = Just grid
-      in case pruneGrid grid1 of
+      | otherwise         =
-          Nothing -> pruneGrid grid2 >>= solve
+          let (grid1, grid2) = nextGrids grid
-          Just grid' -> solve grid' Control.Applicative.<|> (pruneGrid grid2 >>= solve)
+          in solve grid1 <|> solve grid2
-      where
-        possibleVals (Fixed x)     = [x]
-        possibleVals (Possible xs) = xs
 
-        smallestPossible =
+    nextGrids grid =
-          Data.List.minimumBy (compare `Data.Function.on` (length . possibleVals . snd))
+      let (i, first@(Fixed _), rest) = splitPossible . smallestPossible $ grid
-          [(i, c) | (i, c@(Possible _)) <- zip [0..] $ concat grid]
+      in (replace2D i first grid, replace2D i rest grid)
 
-        splitPossible (i, Possible (x:[y])) = (i, Fixed x, Fixed y)
+    smallestPossible grid =
-        splitPossible (i, Possible (x:xs))  = (i, Fixed x, Possible xs)
+      Data.List.minimumBy (compare `Data.Function.on` (length . possibleVals . snd))
-        splitPossible _                    = error "Impossible case"
+      [(i, c) | (i, c@(Possible _)) <- zip [0..] $ concat grid]
 
-        splitGrid =
+    possibleVals (Fixed x)     = [x]
-          let (i, first@(Fixed _), rest) = splitPossible smallestPossible
+    possibleVals (Possible xs) = xs
-          in (replace2D i first grid, replace2D i rest grid)
 
-        replace2D i v = let (x, y) = (i `quot` 9, i `mod` 9) in replace x (replace y (const v))
+    splitPossible (i, Possible (x:[y])) = (i, Fixed x, Fixed y)
-        replace p f xs = [if i == p then f x else x | (x, i) <- zip xs [0..]]
+    splitPossible (i, Possible (x:xs))  = (i, Fixed x, Possible xs)
+    splitPossible _                    = error "Impossible case"
+
+    replace2D i v = let (x, y) = (i `quot` 9, i `mod` 9) in replace x (replace y (const v))
+    replace p f xs = [if i == p then f x else x | (x, i) <- zip xs [0..]]
 
 main = do
   grids <- lines <$> getContents
   Control.Monad.forM_ grids $ \grid ->
     case readGrid grid of
       Nothing -> putStrLn "Invalid grid"
-      Just grid -> case pruneGrid grid >>= solve of
+      Just grid -> case solve grid of
         Nothing -> putStrLn "No solution found"
         Just grid' -> putStrLn $ showGrid grid'