hsudoku (empty) → 0.1.0.0
raw patch · 16 files changed
+895/−0 lines, 16 filesdep +HandsomeSoupdep +QuickCheckdep +basesetup-changed
Dependencies added: HandsomeSoup, QuickCheck, base, bytestring, gi-gtk, haskell-gi-base, hspec, hsudoku, http-client, http-client-tls, hxt, text
Files
- LICENSE +20/−0
- Setup.hs +2/−0
- hsudoku.cabal +88/−0
- src/Hsudoku.hs +35/−0
- src/Sudoku/Loader.hs +47/−0
- src/Sudoku/Solver.hs +145/−0
- src/Sudoku/Type.hs +77/−0
- src/UserInterface.hs +261/−0
- src/Util.hs +41/−0
- test/Spec.hs +2/−0
- test/Sudoku/LoaderSpec.hs +20/−0
- test/Sudoku/SolverSpec.hs +25/−0
- test/Sudoku/TypeSpec.hs +26/−0
- test/TestData.hs +29/−0
- test/UserInterfaceSpec.hs +21/−0
- test/UtilSpec.hs +56/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2017 Marcel Moosbrugger++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.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ hsudoku.cabal view
@@ -0,0 +1,88 @@+name: hsudoku+version: 0.1.0.0+synopsis: Sudoku game with a GTK3 interface+description: This package realizes a graphical GTK3 sudoku game. Moreover it+ provides modules for loading and solving sudoku grids.++license: MIT+license-file: LICENSE+author: Marcel Moosbrugger+maintainer: marcelmoosbrugger@gmail.com+category: Game+homepage: https://github.com/marcelmoosbrugger/hsudoku+bug-reports: https://github.com/marcelmoosbrugger/hsudoku/issues+build-type: Simple+cabal-version: >=1.10++source-repository head+ type: git+ location: git@github.com:marcelmoosbrugger/hsudoku.git ++library+ hs-source-dirs: src++ exposed-modules: Util+ , UserInterface+ , Sudoku.Type+ , Sudoku.Solver+ , Sudoku.Loader++ + build-depends: base >=4.9 && <4.10+ , text >=1.2 && <1.3+ , bytestring>=0.10 && <0.11+ , http-client>=0.5 && <0.6+ , http-client-tls>= 0.3 && <0.4+ , HandsomeSoup>=0.4 && <0.5+ , hxt>=9.3 && <9.4+ , haskell-gi-base>=0.20 && <0.21+ , gi-gtk>=3.0 && <3.1+ + default-language: Haskell2010+ default-extensions: OverloadedStrings, OverloadedLabels++executable hsudoku+ ghc-options: -threaded+ main-is: Hsudoku.hs+ build-depends: base >=4.9 && <4.10+ , text >=1.2 && <1.3+ , bytestring>=0.10 && <0.11+ , http-client>=0.5 && <0.6+ , http-client-tls>= 0.3 && <0.4+ , HandsomeSoup>=0.4 && <0.5+ , hxt>=9.3 && <9.4+ , haskell-gi-base>=0.20 && <0.21+ , gi-gtk>=3.0 && <3.1+ , hsudoku++ hs-source-dirs: src+ default-language: Haskell2010+ default-extensions: OverloadedStrings, OverloadedLabels++test-suite spec+ type: exitcode-stdio-1.0+ ghc-options: -Wall+ main-is: Spec.hs+ hs-source-dirs: test+ build-depends: base >=4.9 && <4.10+ , text >=1.2 && <1.3+ , bytestring>=0.10 && <0.11+ , http-client>=0.5 && <0.6+ , http-client-tls>= 0.3 && <0.4+ , HandsomeSoup>=0.4 && <0.5+ , hxt>=9.3 && <9.4+ , haskell-gi-base>=0.20 && <0.21+ , gi-gtk>=3.0 && <3.1+ , hspec>=2.4 && <2.5+ , QuickCheck>=2.9 && <2.10+ , hsudoku++ other-modules: UtilSpec+ , UserInterfaceSpec+ , Sudoku.TypeSpec+ , Sudoku.SolverSpec+ , Sudoku.LoaderSpec+ , TestData++ default-language: Haskell2010+ default-extensions: OverloadedStrings, OverloadedLabels
+ src/Hsudoku.hs view
@@ -0,0 +1,35 @@+{-|+Module: Main+Description: The main module of the sudoku executable+Copyright: (c) Marcel Moosbrugger, 2017+License : MIT++Contains the main function which sets up the UI of the+sudoku executable.+-}+module Main where++import Data.GI.Base+import qualified GI.Gtk as Gtk+import Sudoku.Type+import UserInterface++-- | The main function which opens a new GTK window in which sudoku games can be+-- played.+main :: IO ()+main = do+ Gtk.init Nothing++ ui <- buildSudokuUI "gui/hsudoku.ui"+ cellsBindHandlers (cells ui) (popover ui)+ numbersBindHandlers (numberButtons ui) (popover ui)+ on (inputClear ui) #clicked $ writePopoverRelativeCell (popover ui) $ blankval+ on (inputSolve ui) #clicked $ solvePopoverRelativeCell (popover ui)+ on (solveButton ui) #clicked $ solveAll (cells ui)+ on (checkButton ui) #clicked $ checkAll (cells ui)+ gameButtonsBindHandlers (gameButtons ui) (cells ui) (menu ui)+ on (menuButton ui) #clicked $ showMenu (menu ui) (popover ui)++ #showAll (window ui)+ Gtk.main+
+ src/Sudoku/Loader.hs view
@@ -0,0 +1,47 @@+{-|+Module: Sudoku.Loader+Description : Provides functions to load a sudoku from the internet.+Copyright: (c) Marcel Moosbrugger, 2017+License : MIT++This module contains functions to load sudokus from the internet.+-}+module Sudoku.Loader(loadSudoku) where++import Data.ByteString.Lazy.Char8 (unpack)+import Data.List (elemIndex, transpose)+import Data.Maybe (fromMaybe)+import Network.HTTP.Client+import Network.HTTP.Client.TLS+import Sudoku.Type+import Text.HandsomeSoup+import Text.Printf (printf)+import Text.XML.HXT.Core+import Util++-- | Converts a difficulty to number which can be plugged into the url.+toNumber :: Difficulty -> Int+toNumber Easy = 40+toNumber Medium = 33+toNumber Hard = 26+toNumber Evil = 17++-- | Creates the url for a given difficullty level from which the sudokus get+-- loaded.+url :: Difficulty -> String+url d = "https://kjell.haxx.se/sudoku/?visade=" ++ (show $ toNumber d) ++ "&seed=%28random+seed%29&action=Create+a+field&hardchange=0"++-- | Loads a sudoku with a given difficulty level from the internet.+loadSudoku :: Difficulty -> IO (Maybe Sudoku)+loadSudoku d = do+ manager <- newManager tlsManagerSettings+ request <- parseRequest (url d)+ response <- httpLbs request manager+ let doc = parseHtml $ unpack $ responseBody response+ values <- runX $ doc >>> css "input.sgrid" ! "value"+ -- in the html the values are aranged block wise and not row wise+ let transposedValues = ungroup . ungroup . transpose . groupBy 3 . groupBy 9+ . ungroup . ungroup . transpose . groupBy 3 . groupBy 3 $ values+ let sudokuString = concat $ map (\v -> if v == "" then blankval:"" else v) transposedValues+ pure (fromString sudokuString)+
+ src/Sudoku/Solver.hs view
@@ -0,0 +1,145 @@+{-|+Module: Sudoku.Solver+Description : Provides functions to solve a sudoku.+Copyright: (c) Marcel Moosbrugger, 2017+License : MIT++This module provides functions for solving a sudoku.+-}+module Sudoku.Solver (solveSudoku) where++import Sudoku.Type+import Util++-- Internal data types+-- -------------------++-- | Internal type representing a two dimensional matrix.+type Matrix a = [[a]]+-- | Internal type representing a sudoku board.+type Board = Matrix Char+-- | Internal type represinting the choices for a single field in the sudoku.+type Choices = [Char]+++-- Helper functions+-- ----------------++-- | Is true iff a character represents an empty field.+blank :: Char -> Bool+blank = (==) blankval++-- | Splits a list into multiple list of length boxsize.+group :: [a] -> [[a]]+group = groupBy boxsize++-- Selection functions+-- -------------------++-- | Converts a matrix arranged in rows to a matrix arranged in rows.+rows :: Matrix a -> Matrix a+rows = id++-- | Converts a matrix arranged in rows to a matrix arranged in columns.+cols :: Matrix a -> Matrix a+cols [xs] = [[x] | x <- xs]+cols (xs : xss) = zipWith (:) xs (cols xss)++-- | Converts a matrix arranged in rows to a matrix arranged in boxes.+boxs :: Matrix a -> Matrix a+boxs = map ungroup . ungroup . map cols . group . map group+++-- Functions for generating choices and pruning+-- -------------------------------------------++-- | For a given board associates all possible (really all possible values)+-- with every blank field.+choices :: Board -> Matrix Choices+choices = map (map choose)+ where choose e = if blank e then cellvals else [e]++-- |For a list of choices returns those choices which are fixed+-- i.e. the choices which leave only a single choice+fixed :: [Choices] -> Choices+fixed = concat . filter single++-- |Reduces every choices in a list by the fixed choices+-- Imagine the parameter being the choices for every field in a single row+-- The function removes the fixed values from the choices of every field in the row+reduce :: [Choices] -> [Choices]+reduce css = map (remove (fixed css)) css+ where remove fs cs = if single cs then cs else delete fs cs++-- | Applies reduce to every unit in the matrix. Regarding to which units the+-- matrix gets reduced depends on the first parameter with which the matrix can+-- get transformed.+pruneBy :: (Matrix Choices -> Matrix Choices) -> (Matrix Choices -> Matrix Choices)+pruneBy f = f . map reduce . f++-- | Prunes a matrix by pruning it by rows, columns and boxes.+prune :: Matrix Choices -> Matrix Choices+prune = pruneBy boxs . pruneBy cols . pruneBy rows+++-- Validity functions for choices+-- ------------------------------++-- | Is true if any field in the matrix has no choices+-- That would mean the resulting sudoku has no solution.+void :: Matrix Choices -> Bool+void = any (any null)++-- | Is true if no unit in the matrix as duplicated fixed elements.+-- That would mean the the resulting sudoku sultion is invalid.+safe :: Matrix Choices -> Bool+safe cm = all (nodups . fixed) (rows cm) &&+ all (nodups . fixed) (cols cm) &&+ all (nodups . fixed) (boxs cm)++-- | Is true if a matrix of choices is either void or not safe+-- That would mean that with the passed matrix of choices no solution can be+-- found anymore.+blocked :: Matrix Choices -> Bool+blocked cm = void cm || not (safe cm)+++-- Functions for expanding and searching for a solution+-- ----------------------------------------------------++-- | Is the minimum number of choices a not fixed field in the matrix has+minchoice :: Matrix Choices -> Int+minchoice = minimum . filter (> 1). concat . map (map length)++-- | Out of a given matrix it creates a list of matrices by fixating every+-- possible choice for one field. The field for which the choices get fixated is+-- the first field with the minimum number of choices.+expand :: Matrix Choices -> [Matrix Choices]+expand cm = [rows1 ++ [row1 ++ [c]:row2] ++ rows2 | c <- cs]+ where (rows1, row:rows2) = break (any best) cm+ (row1, cs:row2) = break best row+ best cs = (length cs == n)+ n = minchoice cm++-- | Searches all possible solutions. A solution is a a matrix of choices in which+-- every field has only a single choice. If a matrix is blocked there is no+-- solution. If its already a solution it's the only solution. The non trivial+-- case is handled by expanding the matrix, pruning all children and then+-- recursivly search within them for solutions.+search :: Matrix Choices -> [Matrix Choices]+search cm+ | blocked cm = []+ | all (all single) cm = [cm]+ | otherwise = (concat . map (search . prune) . expand) cm++-- | Solving a soduku is now just generating all choices, searching for solutions+-- for this choices and then converting the list of matrices of choices back to+-- a list of matrices of characters (or boards). Pruning the choices before+-- passing them on to the search improves the performance.+solve :: Board -> [Board]+solve = map (map $ map head) . search . prune . choices++-- | Returns a list of all solutions for a given sudoku.+solveSudoku :: Sudoku -> Maybe [Sudoku]+solveSudoku = sequence . map fromString . map concat . solve . groupBy boardsize . toString+
+ src/Sudoku/Type.hs view
@@ -0,0 +1,77 @@+{-|+Module: Sudoku.Type+Description : Data types and constructors regarding sudokus.+Copyright: (c) Marcel Moosbrugger, 2017+License : MIT++Defines the data types and constructors regarding sudokus.+-}+module Sudoku.Type(+ Sudoku+ , Difficulty(..)+ , boardsize+ , boxsize+ , cellvals+ , blankval+ , fromString+ , toString+) where++import Util++-- Data types+-- ----------++-- | The data type representing a single sudoku board.+newtype Sudoku = Sudoku String++-- | Representing the difficulty level of a sudoku.+data Difficulty = Easy | Medium | Hard | Evil deriving (Read, Show, Eq, Enum)++instance Show Sudoku where+ -- | Turns the sudoku into a pretty string representation of a board.+ show (Sudoku s) = "\n" ++ (concat $ map showThird grouped) ++ line+ where grouped = groupBy boxsize . map (groupBy boxsize) . groupBy boardsize $ s+ showThird t = line ++ (concat $ map showRow t)+ showRow r = (concat $ map showRowThird r) ++ "|\n"+ showRowThird rt = "|" ++ (concat $ map showCell rt)+ showCell c = " " ++ (c : " ")+ line = (concat $ replicate boardsize "---") ++ (concat $ replicate boxsize "-") ++ "-\n"++-- Parameters+-- ----------++-- | The side-length of the sudoku.+boardsize :: Int+boardsize = 9++-- | The side-length of boxes in the sudokus.+boxsize :: Int+boxsize = 3++-- | The symbols which can be inserted into sudokus.+cellvals :: [Char]+cellvals = "123456789"++-- | The symbol representing an empty field.+blankval :: Char+blankval = ' '++-- Constructors+-- ------------++-- | True iff from a given string a sudoku can be created.+valid :: String -> Bool+valid s = (length s == (boardsize * boardsize)) &&+ (all (`elem` blankval:cellvals) s)++-- | Creates a sudoku from a valid string.+fromString :: String -> Maybe Sudoku+fromString s+ | valid s = Just $ Sudoku s+ | otherwise = Nothing++-- | Returns the string representation of a sudoku.+toString :: Sudoku -> String+toString (Sudoku s) = s+
+ src/UserInterface.hs view
@@ -0,0 +1,261 @@+{-|+Module: UserInterface+Description: Provides various functions for building the user interface.+Copyright: (c) Marcel Moosbrugger, 2017+License : MIT++Provides various functions for building the user interface of the+sudoku application.+-}+module UserInterface (+ BuilderCastException(..)+ , SudokuUI+ , window+ , menu+ , gameButtons+ , cells+ , popover+ , numberButtons+ , inputClear+ , inputSolve+ , solveButton+ , checkButton+ , menuButton+ , buildSudokuUI+ , writePopoverRelativeCell+ , solveAll+ , solvePopoverRelativeCell+ , checkAll+ , cellsBindHandlers+ , numbersBindHandlers+ , gameButtonsBindHandlers+ , showMenu+ ) where++import Control.Exception+import Control.Monad.IO.Class+import Data.GI.Base+import qualified Data.Text as T+import Data.Typeable+import GI.Gtk+import Sudoku.Type+import Sudoku.Loader+import Sudoku.Solver+import Control.Concurrent (forkIO, threadDelay)+++-- | Thrown when 'castB' fails get an object.+data BuilderCastException = UnknownIdException String deriving (Show, Typeable)++instance Exception BuilderCastException++-- | Alias type for a sudoku cell+type Cell = Button+-- | Alias type for all sudoku cells+type Cells = [Cell]+-- | Alias type for the game menu+type GameMenu = Widget++-- | A type containing all handles of widgets necessary for the user interface.+data SudokuUI = SudokuUI { window :: Window + , menu :: GameMenu+ , gameButtons :: [Button]+ , cells :: Cells+ , popover :: Popover+ , numberButtons :: [Button]+ , inputClear :: Button+ , inputSolve :: Button+ , solveButton :: Button+ , checkButton :: Button+ , menuButton :: Button+ }+++-- | Builds the sudoku-ui from a gui-file for which the path is given.+buildSudokuUI :: T.Text -> IO SudokuUI+buildSudokuUI guiFilePath = do+ (window, builder) <- buildMainWindow "mainWindow" guiFilePath+ menu <- builderGetTyped builder "menu" Widget+ gameButtons <- builderGetsTyped builder gameButtonNames Button+ cells <- builderGetsTyped builder cellNames Button+ popover <- builderGetTyped builder "inputPopover" Popover+ numberButtons <- builderGetsTyped builder numberNames Button+ inputClear <- builderGetTyped builder "inputClear" Button+ inputSolve <- builderGetTyped builder "inputSolve" Button+ solveButton <- builderGetTyped builder "solveButton" Button+ checkButton <- builderGetTyped builder "checkButton" Button+ menuButton <- builderGetTyped builder "menuButton" Button+ pure $ SudokuUI window menu gameButtons cells popover + numberButtons inputClear inputSolve solveButton+ checkButton menuButton++-- | The ids of the sudoku cells in the ui file.+cellNames :: [T.Text]+cellNames = map (T.pack . (++) "cell") $ map show [1..81]++-- | The ids of the inputs for the numbers in the ui file.+numberNames :: [T.Text]+numberNames = map (T.pack . (++) "input") $ map show [1..9]++-- | The ids of the buttons which start a new game+gameButtonNames :: [T.Text]+gameButtonNames = map (T.pack . (++) "game" . show) [Easy ..] ++-- | Takes a builder and returns the object with a given name+-- typed as a given gtype.+builderGetTyped :: (IsBuilder a, GObject o, MonadIO m) => a -> T.Text -> (ManagedPtr o -> o) -> m o+builderGetTyped builder ident gtype =+ liftIO $ do+ o <- builderGetObject builder ident+ case o of+ Just a -> unsafeCastTo gtype a+ Nothing -> throw $ UnknownIdException $ T.unpack ident++-- | Same as builderGetTyped for a list of names.+builderGetsTyped :: (GObject a, IsBuilder b, MonadIO m) => b -> [T.Text] -> (ManagedPtr a -> a) -> m [a]+builderGetsTyped b is t = sequence $ map (\i -> builderGetTyped b i t) is++-- | Builds the main application window from a xml definition file for which the+-- path is given.+buildMainWindow :: MonadIO m => T.Text -> T.Text -> m (Window, Builder)+buildMainWindow name path = liftIO $ do+ builder <- builderNewFromFile path+ window <- builderGetTyped builder name Window+ on window #destroy mainQuit+ windowAddCss window "gui/theme.css"+ pure (window, builder)++-- | Adds to a given window a css file for which the path is given.+windowAddCss :: (MonadIO m, IsWindow a) => a -> T.Text -> m ()+windowAddCss window path = liftIO $ do+ screen <- windowGetScreen window+ cssProvider <- cssProviderNew+ cssProviderLoadFromPath cssProvider path+ styleContextAddProviderForScreen screen cssProvider 1000++-- | Writes a character into a sudoku cell.+writeCell :: Cell -> Char -> IO ()+writeCell cell char = #setLabel cell (T.singleton char)++-- | Writes a charachter into a cell which is associated to a given popover+-- The popover gets closed afterwards.+writePopoverRelativeCell :: Popover -> Char -> IO ()+writePopoverRelativeCell popover char = do+ widget <- #getRelativeTo popover+ cell <- unsafeCastTo Button widget+ writeCell cell char+ #hide popover++-- | Solves a given cell.+solveCell :: Cell -> IO ()+solveCell cell = do+ char <- T.head <$> #getName cell+ writeCell cell char++-- | Solves all given cells.+solveAll :: Cells -> IO ()+solveAll = mapM_ solveCell++-- | Solves the cell currently relative to the popover.+solvePopoverRelativeCell :: Popover -> IO ()+solvePopoverRelativeCell popover = do+ cell <- #getRelativeTo popover >>= unsafeCastTo Button+ solveCell cell+ #hide popover++-- | Binds the signal handlers to buttons.+cellsBindHandlers :: Cells -> Popover -> IO ()+cellsBindHandlers cells popover = mapM_ (\c -> do+ on c #focusInEvent $ focusInHandler c+ ) cells+ where focusInHandler c _ = do cellShowPopover c popover; pure False++-- | Checks and returns if a given cell contains the correct value.+-- If the value is not correct the cell gets visually marked.+checkCell :: Cell -> IO Bool+checkCell cell = do+ solution <- T.head <$> (toWidget cell >>= #getName)+ actual <- T.head <$> #getLabel cell + let isCorrect = actual == solution+ style <- #getStyleContext cell+ if not isCorrect+ then #addClass style "incorrect"+ else pure ()+ forkIO $ threadDelay 800000 >> #removeClass style "incorrect"+ pure isCorrect++-- | Checks if all given cells contain the correct value.+-- Visually marks the correct or incorrect cells.+checkAll :: Cells -> IO ()+checkAll cells = do+ allAreCorrect <- and <$> mapM checkCell cells+ if allAreCorrect+ then mapM_ (\cell -> do+ style <- #getStyleContext cell+ #addClass style "correct"+ forkIO $ threadDelay 800000 >> #removeClass style "correct"+ ) cells+ else pure ()++-- | Associates the popover to a given button and shows the popover.+cellShowPopover :: Cell -> Popover -> IO ()+cellShowPopover cell popover = do+ popover `set` [#relativeTo := cell]+ #show popover++-- | Binds the signal handlers to a list of number buttons.+numbersBindHandlers :: [Button] -> Popover -> IO ()+numbersBindHandlers buttons popover = mapM_ (\b -> do+ on b #clicked $ numberButtonInsert b popover+ ) buttons++-- | Inserts the content of a number button to a cell associated to the popover.+numberButtonInsert :: Button -> Popover -> IO ()+numberButtonInsert button popover = do+ label <- #getLabel button+ writePopoverRelativeCell popover $ T.head label++-- | Writes a sudoku into a list of buttons.+writeSudoku :: Cells -> Sudoku -> IO ()+writeSudoku cells sudoku = do+ let sudokuChars = toString sudoku+ sequence_ $ zipWith (\c sc -> do+ writeCell c sc+ if sc == blankval+ then c `set` [#sensitive := True]+ else c `set` [#sensitive := False]+ ) cells sudokuChars++-- | Stores a given solution in the names of the passed cells.+writeSolution :: Cells -> Sudoku -> IO ()+writeSolution cells sudoku = do+ let sudokuChars = toString sudoku+ sequence_ $ zipWith (\c sc -> do+ #setName c (T.singleton sc)+ ) cells sudokuChars++-- | Binds the signal handlers to the game buttons in the menu.+gameButtonsBindHandlers :: [Button] -> Cells -> Widget -> IO ()+gameButtonsBindHandlers buttons cells menu = do+ mapM_ (\button -> do+ label <- #getLabel button+ let d = read . T.unpack $ label+ on button #clicked $ newGame d cells menu+ ) buttons++-- | Prepares a new game in the UI.+newGame :: Difficulty -> Cells -> GameMenu -> IO ()+newGame d cells menu = do+ Just sudoku <- loadSudoku d+ let Just solution = head <$> solveSudoku sudoku+ writeSudoku cells sudoku+ writeSolution cells solution+ #hide menu++-- | Shows the menu and ensures that the popover is hidden.+showMenu :: GameMenu -> Popover -> IO ()+showMenu menu popover = do+ #hide popover+ popover `set` [#relativeTo := menu]+ #show menu+
+ src/Util.hs view
@@ -0,0 +1,41 @@+{-|+Module: Util+Description : Provides generic utility functions on lists+Copyright: (c) Marcel Moosbrugger, 2017+License : MIT++This modules provides generic utility functions for lists.+-}+module Util (+ nodups+ , groupBy+ , ungroup+ , single+ , delete+) where++import Data.List ((\\))++-- | Is true iff a list has no duplicate elements.+nodups :: Eq a => [a] -> Bool+nodups [] = True+nodups (x:xs) = x `notElem` xs && nodups xs++-- | Splits a list into multiple lists of a given length.+groupBy :: Int -> [a] -> [[a]]+groupBy n [] = []+groupBy n xs = (take n xs) : groupBy n (drop n xs)++-- | The reverse operation of groupBy.+ungroup :: [[a]] -> [a]+ungroup = concat++-- | Is true iff a given list contains exactly one element.+single :: [a] -> Bool+single [a] = True+single _ = False++-- | Removes the elements of the first list from the second list.+delete :: Eq a => [a] -> [a] -> [a]+delete = flip (\\)+
+ test/Spec.hs view
@@ -0,0 +1,2 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}+
+ test/Sudoku/LoaderSpec.hs view
@@ -0,0 +1,20 @@+module Sudoku.LoaderSpec (main, spec) where++import Data.Foldable (forM_)+import Data.Maybe+import Sudoku.Loader+import Sudoku.Type+import Test.Hspec++-- `main` is here so that this module can be run from GHCi on its own. It is+-- -- not needed for automatic spec discovery.+main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "loadSudoku" $ do+ it "should actually load and return a sudoku" $ forM_ [Easy ..] $ \d -> do+ maybeSudoku <- loadSudoku d+ isJust maybeSudoku `shouldBe` True+
+ test/Sudoku/SolverSpec.hs view
@@ -0,0 +1,25 @@+module Sudoku.SolverSpec (main, spec) where++import Data.Maybe (fromJust, isJust)+import Sudoku.Solver+import Sudoku.Type+import Test.Hspec+import Test.QuickCheck+import TestData++-- `main` is here so that this module can be run from GHCi on its own. It is+-- -- not needed for automatic spec discovery.+main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "solveSudoku" $ do+ it "should return something" $ property $+ \(TS s) -> isJust $ solveSudoku s++ it "should not contain blank values" $ property $+ \(TS s) -> let solutionStrings = map toString (fromJust $ solveSudoku s)+ in and $ map (all (/= blankval)) solutionStrings++
+ test/Sudoku/TypeSpec.hs view
@@ -0,0 +1,26 @@+module Sudoku.TypeSpec (main, spec) where++import Data.Maybe (fromJust, isJust)+import Sudoku.Type+import Test.Hspec+import Test.QuickCheck+import TestData++-- `main` is here so that this module can be run from GHCi on its own. It is+-- -- not needed for automatic spec discovery.+main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "toString" $ do+ it "should return a non empty string for a sudoku" $ property $+ \(TS s) -> length (toString s) > 0++ describe "fromString" $ do+ it "should not fail for already existing sudokus" $ property $+ \(TS s) -> isJust (fromString $ toString s)++ it "should be inverse to toString" $ property $+ \(TS s) -> (toString . fromJust . fromString . toString) s == toString s+
+ test/TestData.hs view
@@ -0,0 +1,29 @@+module TestData where++import Data.Maybe (fromJust)+import Sudoku.Type+import Test.QuickCheck++newtype TestSudoku = TS Sudoku++instance Arbitrary TestSudoku where+ arbitrary = elements $ map TS sudokus++instance Show TestSudoku where+ show (TS s) = show s++sudokus :: [Sudoku]+sudokus = easySudokus ++ mediumSudokus ++ hardSudokus ++ evilSudokus++easySudokus :: [Sudoku]+easySudokus = map (fromJust . fromString) [" 8 94 3 53 176 9454 6 2 9 2 5 2 7 8 5192 547 96 3 54 2 ","7 9 3 168 27 5 7 39 36 7 15 1 9 14 6 92 68 5 7 95 322 8 6 9"," 9 669 78 52 47 4 5 279 1 3 8 587 6 4 91 23 23 942 8 "," 2758 68 6 7 9 684 1 59 3 3 4 5 7 21 7 963 8 4 9 36 3429 "," 2 97 5 948 671 3 5 7 51 9 7 18 3 6 8 683 479 1 93 4 "," 35 4 9 2 36 5 97 5 49 26 694 41 37 8 16 4 73 8 1 2 37 "," 9 4 6 9 3 1 7 928 25 79 14 4 5 2 61 43 78 283 6 4 5 6 5 2 4 ","4 6 13 17 3 98 7416 9 7 5 4 5 1 3 5 8 3 7152 63 9 72 17 5 4","1 3 85 67 15 9 8 9 1 2 8 6 5 6 3 4 7 5 3 2 4 5 46 94 68 3 5"," 7 5 1 3 26 2 8519 8 973 719 642 421 9 9582 7 47 6 1 8 4 "," 6 57 26 75 71 26 3457 9 6 3 7 5 4 1675 32 81 71 34 72 8 ","9 35 481 6 334 9 2 56 17 85 82 56 61 8 5 322 1 778 23 4"," 8 27 4 4986 25 7 6 8 1 41 3 67 5 1 2 1 37 5489 9 21 5 "," 4 36 2 97 43 3 7 828 3 51 41 39 67 5 245 9 4 19 82 4 82 5 ","6782 9 7 16 5 4 3 87 395 58 72 659 24 9 5 3 83 1 3 4628"," 376 2 5 781 1 24 37 6 3217 9548 7 19 82 6 895 2 2 648 ","45 9 6 961 4 87 3 6472 9 89 41 7 4952 8 19 9 814 7 2 83"," 1 72 5 85 1 72 9851 1 58 3 8 4 5 46 8 7531 63 4 21 1 72 3 ","12 7 8 18 79 592 1 541 7 1 6 4 6 273 7 639 38 14 1 7 46","79 3 5 7 2 89 21 9 5 94 3 38 6 27 4 87 5 6 73 16 9 8 3 5 16"," 47 38 38 1 581 2 71 353 472 56 3 496 9 15 56 78 ","84 6 7 16 8 17 358 63 8 4 671 1 3 54 519 67 9 37 8 3 94"," 16 25 2 64 57 8913 5 9348 8127 6 6173 94 95 3 23 47 "," 8941 87 2 9 6 37 8 49 6 4 3 5 3 86 7 13 9 2 9 43 5473 "," 5 1 7 9 38 41 1 4 8 89 5475 4 1848 53 7 6 2 82 71 9 9 3 5 "," 351 974 69 57 1 1 4 2 7 6 4 2 8 8 4 6 9 5 9 56 84 354 276 "," 6 28 5 8512 436 143 2 52 9 1 45 7 289 795 8143 6 49 8 "," 37 614951 64 1 1 496 8 96 34 7 612 9 7 83 644823 79 "," 396 879 1 7 1 9638 3 24 845 13 9 8596 8 2 8 934 259 "," 469 47 4 8 9312 9 14 31 8 26 23 8 5812 5 9 86 776 "," 6 399812 7 98 5 2 45 15 9 7 38 13 2 3 74 9 236446 9 "," 3 8 1 8 532 5 2 72 3 8 6939 2 6 7181 7 9 34 3 6 695 2 8 3 4 ","3 2 45 7 541 38 138 5 2 8 267 3 4 7 598 61 457 4 29 2 1","3 27 1 6 289 36 5 69 87 7 6 4 1 93 67 5 24 816 2 9 78 3"," 2 4689 1 9 45 612 2846 3 2 7249 465 18 7 3 2396 5 ","29 4 8 3 79 4 125 4 3 9 5 849 6 6 2 4 619 4 49 3 5 7 26","4 3 6 91 83165 4 79 846 6 2 294 57 6 92351 24 8 8 2","6 9 4 89 146 2 5 7 83 16 5 968 3 87 96 2 1 7 284 36 3 1 7","412 9 3 96 1 2 8 4 746 8 741 962 3 291 7 6 9 2 75 8 9 324","95 2 68 261 34 1 2 91 9613728 17 4 8 35 286 16 9 25","9 87 2 8 6 129 4 712 5 85 971 62 6 513 7 816 4 2 6 72 9"," 3 1 87 54 651 8 2 9 2 6 263 198 5 6 3 1 5 342 63 89 7 1 ","7 6 9 2 69 3 8 4 67 94 72 7 8 43 12 12 4 6 7 85 1 5 9 2","59 214 12 4 569 456 1 6 5 8 3 8 7 2 847 731 5 46 817 52","1493 8525 34 7 35 6 2 8 41 56 6 2 9 14 2 37 6497 6321"," 6 5 7 7 69 1 3 8 5 21 3 786 2 1 979 8 52 9 1 8 5 72 9 1 3 2 ","79 2 65 4 1 1657 4 2 69 8 2 3 4 8 34 9 2 1952 1 8 85 4 69"," 6 54 8 79 36 7 13 57 42 83 2 4 78 41 56 95 8 98 24 3 12 3 ","9 2 6 43 2 491 5 35 8 6 2 7 95 24 2 5 8 2 19 5 946 7 18 4 2 9"," 4 95 3 5 4 2 26 3 98 7 125 683 7 46 7 16 8 9 5 1 63 9 "," 7 196 4 1 8 5 659 78 7923 6 8 1724 58 276 3 8 1 2 294 6 "," 56 8 7 637 44 2 5 8 1 684 1 3 394 2 3 7 6 52 493 9 3 54 "," 5674 1 279 91 6 6 37 2 83 67 2 54 8 7 14 629 4 4725 "," 64 917 2 1 4 872 6 38 9512 4451 86 1 375 8 1 6 923 85 ","6 32 471 1 4 4 87 8 35 411 2 539 41 7 31 2 9 8 164 95 3","47 3 8 62 8 4 1 42 4 86 2 3 2 9 1 1 93 4 84 1 1 5 28 3 1 57","7 5 8 9 3 7 85 2 4 716 41 5 7 7 9 8 9 34 648 2 5 57 1 2 6 4 3 8"," 92 6 8 2 7 6 3 4 1581 5 9 37 4 6 36 8 1 2415 9 3 2 9 5 7 4 59 ","9571 6 4 375 6 2 19 7 12 657 34 6 73 4 9 298 6 5 9123","54 6 1 79 63 68 75 5 18 68 7 2 93 13 8 68 59 51 32 9 4 61"," 12 4 13 4 46 539 1 8973 38 91 9763 5 429 53 8 69 1 45 "," 1 427 7 5 1661897 3 56 8 3 2 1 54 3 9672552 8 3 692 5 "," 7948 1 23 7 3 8 5 6 14 67 7 5 56 94 6 7 2 5 3 59 8 2843 "," 9 3 5 5 97 84 3 2 83 56 7 73 1 89 2 47 95 2 6 42 97 3 8 1 4 "," 9 6 2 2 8 3 1 915 8 4 6991 675 3463 1 8 192 4 3 6 1 5 3 7 ","65938 1 2 73 3 2 46 738 3 1 712 84 9 7 58 1 7 61529"," 8 4 2 4 9 35 3 29 3 86 1 5814937 1 23 5 13 7 88 4 1 6 1 3 "," 74 3242 7 6 9 24 3 9 251 23 56 845 1 7 16 4 7 4 2535 97 ","5 963 86 2 1 9 1 8 5 278 43 1 5 39 178 9 8 3 7 3 4 25 768 4","1 827 4 2 81 61 5 8 5 42 2 1 8 5 6 75 2 8 5 74 39 6 4 163 2","2 619 5917 8 67 2 324 1 4 8 7 659 9 42 2 4739 967 1"," 278 135 94 89 6 9214 35 1 82 1457 6 78 25 167 953 "," 8 9 3 36 1 7542 3 6735 98 2 5 59 4271 4 6793 8 52 5 2 3 "," 7 1 63 1 82 92 8 7 43 89 69 82 74 95 9 7 84 68 3 17 3 2 "," 6 7 9 7531 2 3 1 9 3 7 24 875 491 41 2 5 3 4 7 6 2189 5 5 7 ","37 26 8 7 8 62 547 1 53 5 983 6 34 5 145 76 6 4 7 15 32"," 9 5 285 32 379 5 7 4 26 9 579 6 84 7 2 9 325 21 964 9 1 "," 9 31 2 52 97 825 3 1 9 8 48 17 3 8 2 5 278 85 67 1 36 4 ","1 6 35 9 3 84 72 2 94 82 19235 36 58 6 76 34 2 5 92 7 8","8 2 64 8 9 21 9 5 93 2 4 65 91 4 3 25 2 7 16 1 9 32 6 8","2 9 6 7 1 9 8 7 9 6 714 3 4258 7169 9 657 9 6 2 5 2 9 5 4 7 1"," 7 91 5 19 23 6 7 48 1 349 4 8 465 8 23 1 2 49 18 8 94 7 "," 248 7951 6 48 9 3 46 2 93416 9 84 5 2 93 1 7872 945 "," 48 39 1 39 1 4681 86 9 6 85 75 2 3 51 2972 8 61 5 92 38 ","5 7 91 1 75 84 42 81 74 1 3 2 5 5 3 87 49 53 54 82 1 63 5 8","7 83 952 698 4 83 683 7 2 915 37 6 697 251 47 3","25 8 6 43 6 29 5 1 75 2 543 8 7 461 3 78 9 8 45 3 77 2 1 48"," 19 61 5 8 7 1 6 49 2 47 5132496 38 2 15 9 3 3 9 7 85 27 "," 3961 8167 3 56 1 7 96 216 394 28 6 2 19 7 6824 8293 ","9 87 6 942 5 2 1 9 7 4 1 55 7 9 31 8 2 9 7 8 4 5 496 3 31 2"," 3 6 2 5 4 928 5 81 369 153 496 831 34 5 912 5 6 8 3 4 ","8 476 3 9 1 78 9 542 5 7 53 42 1 2 913 2 49 7 1 8 619 7","87 9 23 234 51 7 9 275 2 5 3 4 514 8 4 72 568 49 8 15"," 8 56 6 2 6 27 3 369 8 79 51236 44 6 713 6 43 2 8 1 53 1 ","8 5279 19 1 3 4 5766 75 18 97 62 5256 9 9 4 21 4295 7"," 57 3889 7743 8 26 4 3 5 5 1 8 4 8 5 12 1 6539 2458 47 "," 258 4 5739 6 6 21 3 7 85 2 4 1 3 41 5 5 78 2 1 3658 8 924 "," 2 9 1 9 61423 1 398 9 5 425 166 3 1 268 3 71532 4 3 1 7 "," 5 27 1 24 5 23 5 6 93 2 14 493 87 5 29 6 2 48 5 14 3 81 5 ","98 45 6 42 3 8 36 9 261 7 5 3 9 5 8 136 8 65 1 5 72 9 14 67"]++mediumSudokus :: [Sudoku]+mediumSudokus = map (fromJust . fromString) [" 5 3 17 8 59 52147 8 63 2 659 8 61 3 84359 63 7 41 9 2 ","96 4 8 7 3 8 9 8 6 9 649 23 92 71 14 879 9 4 7 1 8 6 2 9 2 83"," 4 2 32 8 913 9 65 4152 6 89 14 5 4316 26 3 985 1 64 3 9 ","15 4392 7723 6 9 1 9 87 6 2 52 7 2 1 1 8944 5798 26"," 8 395 79 9 1286 2 3475 5 8 1 9 6395 7 5978 6 89 286 5 "," 7 1 9 9 5 8 6845 6 2 1 64 2 3 8 82 3 3 9 4177 9 2 5 6 7 9 "," 175 66 1 857 943 17 5 9 6 8 1 7 39 453 263 4 95 612 ","6 1 7 35 2 6 3 859 6 24 7 7 164 9 2 54 1 628 7 9 1 58 3 4 2"," 61 395 8 4 1 3 28 9317 875 413 8546 41 7 3 6 5 537 19 ","3 67 4 753 69 54 4 3 51 2 1 3 4 7 6 21 3 4 24 39 271 3 53 9"," 548 7 98 73 55 729 6 4 2 147 8 4 3 659 72 74 69 9 523 ","6 214 3 3 7196 28 91 7824 7365 19 75 3894 6 4 795 1","269 5 47 39826 8 7 8 16 5 2 42 6 2 7 34681 52 7 138","47 35218 3 9 7 62 6 41 298 69 5 81 5 7 9 94185 67"," 4 8 7 7 56838 96 1 1 874 4 5 6 2 291 4 6 58 13157 4 4 1 2 ","4 75 3 7315 1 2 4 86 9 6 2 2 7 3 1 9 2 5 54 8 3 9 6184 8 64 5"," 7 3 1276 8 5 3953 98 6 23 75 1 65 8734 8 1 5397 5 4 "," 534 7 8 7 4296 29 48 5 1 8 1 75 26 4974 8 2 3 735 "," 73 269 8 97 369 4 5 7 146 7 9 326 6 1 9 525 27 4 285 13 ","5 89 3 31 5 42 5 1 462 37 975 27 345 5 9 36 9 83 7 85 9","7 1 5 25 9 14 6 8 2 1 382 5 89 17 3 574 9 2 7 4 57 3 69 6 9 2","6 21 25 38 8 42 37 59 29 4 3 51 26 73 48 6 32 51 61 4"," 2 6 9 5 57 34 1 972 38 85 69 12 82 64 785 3 83 94 2 1 4 6 ","5 84 63 7 6 8 92547 29 68 1 3 27 98 16489 7 6 9 42 51 8"," 9 6 853 6 83 9 2764 38 2 9 5 6 48 7234 3 96 1 941 7 2 ","1 9 8 38 1 6 52 49 713 52 93 64 64 927 36 51 6 8 79 9 3 1","1 7 364 5 6 9 74 1 6 1 7 9 4 891 3 8 6 1 5 6 91 4 3 9 376 2 1","2 45 6 36 27 5 41 3 297 2 59 53 1 318 4 76 4 76 38 7 13 4","86379 2 41 2 92 4 65 5 3 6 1 9 6 1 2 82 3 73 2 98 7 81234","31 6 42 7 5 14 567 3 9 9 3 63 72 2 9 6 2 891 41 7 2 54 1 67"," 15 89 4 6 23 1 2 8 6 5 735 7 281 7 2 9 3 4 86 8 7 61 94 "," 6 1 23 41 5 74 76 2 4 99 2 8 6 15 9 3 79 56 8 52 43 7 9 "," 6 17 95 2 4 6 153 24 7 948 526 8 76 143 8 5 2 86 49 3 ","6 79 594 8 7 635 4 5 4 2 7 352 2 3 9 8 4 819 3 8 679 97 1"," 6 7 3 42 1 59 2 451 8 497 67 95 579 1 847 6 93 9 27 6 5 8 ","8 9 1 92 65 754 1 8 7 4 9 2 9 5 6 8 1 5 8 1 239 27 38 4 4 1"," 745 4 79 26 2 8 9 581 6 1 8 8 631 4 1 5 75 37 2 867 ","8762 1 25 87 4 2 5 83214 3 95758 4 2 1 41 83 4 5762","258 3 7 9 27 81 7 5 2 39 48 6 3 13 95 3 2 1 86 71 9 1 5 826"," 31 6 12 87 3 7 3 8 2 6 73 9 294 2 58 3 8 7 2 4 3 81 65 4 32 ","82 613 6 2987 47 3 1 18 6 4 5 8 95 5 7 81 2689 7 783 69","763 9 9 5 8 21 9668 2 5 9 56 42 1 7 8 6357 94 9 3 1 1 947"," 218 7 5 76 87 91 3 6 36 9 1 1 3 9 5 26 1 8 26 34 38 7 9 584 ","1342 965 521 7 52 8 69 13 58 86 4 13 6 278 417 8236"," 5 8 3 75 9461 3 367 29 1 8 5 4 7 4 37 268 3 5847 72 4 8 2 "," 64 93 9167 48 4 1 81 2 6 9 7 5 3 5 8 12 2 7 58 3796 74 63 ","65 9 2 1 2 57 163 5629 4 7 1 2 3857 948 91 2 5 6 4 92"," 3678 2 65 58 367 2 39 4 291 3 56 2 671 42 26 9 3416 "," 7 4 9836 6 15 32 7 58 85 2 31 91 5 62 78 4 4967 2 8 ","1 5 3 42481 7 5 4 6 34 5 91 8 9 85 3 26 4 6 5 3 74123 1 6 5"," 15 6 4 5 97 893 21 29 75 7 2 9 93 58 17 453 37 4 9 4 76 "," 7 23965 83 64 7 65 1 1 7 98 12 5 4 6 84 4 67 19 98413 6 "," 4 1356 85 9 31 8 7 2 14861 95234 5 9 3 43 2 17 5697 8 ","62 84 3487 9 27 9 7 3 3189 4257 2 6 9 43 8 6142 15 39","78 1 3 89 95817 4 7 8 4 163 928 4 9 3 1 26437 36 4 7 61","6 23 75 1 2 4 42 3 3 1 4 64 51 7 8 6 9 36 8 6 1 24 59 8","4 19 28758 1 624 3 47 6 5 2 7 6 85 1 783 5 49132 24 8"," 7 26 15 3748 6 96712 4 7 6 1 65972 8 2136 53 29 6 "," 28 53 1 7 8 8 26 9412 3 5 6 9 4 5321 71 3 6 3 4 83 97 ","34 1 6 71 71 53 12697 91 7 23 62798 69 15 98 3 1 29","69 731 51 2 8 6 37 1 49 8 2 67 1 82 3 9 7 14 258 79"," 6 7134 9 5 7 3 4 6 3 7 92 871 264 24 9 1 3 2 7 1 7 5 9486 1 ","8 6 5 21548 6 5 71 9 6 5 9 96 41 2 4 3 3 75 6 1 52693 6 3 1","6 8 3 2 23 6 1 4 8 3 71 6 32 3 5 96 4 58 9 6 1 6 7 43 7 9 4 8","21 9 365 7 6 8 3 6 79 5127 8 5 3784 93 5 1 4 9 2 542 1 87"," 927 4 2 8 16 47 1 2 6 8 96 5 43 8 7 9 2 19 51 3 4 4 851 "," 7 4 8 258 7 6573 2 65 1 423 981 2 63 1 8749 3 425 7 9 3 ","7 9 6 583 2 519 52 1 7 7 8 49 71 8 4 1 3 25 549 2 793 1 8 4"," 3 2 1789 78 652 148 994 125 914 632 97 6937 6 8 ","3 2 6 31 215 98 9 415645 1 8 931932 6 87 965 81 4 5 1","49 6 7 7 4892823 5 835 827 467 7 1696349 2 9 5 83"," 56 4 9 1 3242 9 16 138 86 2 1 54 548 54 3 9838 9 9 2 15 "," 2 3 1643 5 1 41 243 96 6 187 2 45 961 36 3 1 5931 8 7 ","2763 1 9 81 1 6 77495 3 8 8 8 3 97256 2 4 38 6 5 1293","241 7 87 12 53 6 4 6 5 12 8 95 6 2 7 3 91 34 63 8 714"," 5 96 2 68 1 687 52 6 3 2 2 8 5 9 7 8 45 728 3 42 1 71 4 "," 6 52 32 79 17 1 2 9142 6 3 6 1 6 5974 9 8 73 74 66 53 4 ","4 726 5837 5 2 3 7 5 7 9 4 914 9 3 6 1 7 3 8 5 1761 648 3"," 6 4 1 5 6 9974 7 2451 9 139 645 9 7831 6 8315 1 7 4 1 5 ","5 4 9 4837 25 2 1 6 3 7183 7 5 9217 2 4 3 5 64 5287 9 5 6"," 6 438 21 3 96 9 1 7 3 2 3 48 8 45 1 3 8 9 3 7 92 5 17 845 9 "," 6 14 7 2 4 353 25 6 7 8 64 15 46 72 3 1 7 36 489 1 7 4 35 8 ","5 2 67 48 167 312 97 3 39 12 8 31 494 356 52 36 4 7"," 1 7 467 93 5 854 2 59 47 6 8 5 95 64 1 219 5 29 843 9 5 "," 7 2 588 15 2629 3 76 9 86214 4 51 6 3274 36 156 2 9 ","5 9 368 6 9 8 81 4 5 62 1 41 6 23 2 94 2 8 71 6 4 8 831 2 5"," 74 6 2 85 3 6 3 7 61 7 5 82 64 5 1 72 8 3 4 6 17 7 9 48 "," 8 1 6 2 6 967 32548 8 9 5 2 1 8 7 1 3 76928 543 5 1 5 6 8 ","7 36 95 6 24 89 7 35473 8 5 6 1 38784 7 33 84 1 66 95 4","83 1 9 73 2 4 5 8 7 41221 9 4 75485 7 9 4 9 4 82 7 3 51"," 56 4 1675 858 1 8961 7 1 5 3 6 4 9271 5 966 3458 1 76 ","374852 9 6 758 5 3 385 7 6 9 7 296 3 2 627 5 1 428376","7 914 14 5 7 42 9 6 2 3 28 1 75 4 3 8 9 76 3 9 48 236 7"," 5 2 1 47 343 12 5 4 3 6 2 967 1 6 1 5 4 16 927 39 8 9 3 "," 4 8 2 97 1554 397 629 914 653 275 726 8915 38 4 3 7 "," 1 786 351 4 4 27 69 64 5 3 6 8 7 93 46 59 8 9 274 535 9 "," 2 6 3 5 9616279 4 1 729 9 5 1 2 396 1 1 8765985 3 3 4 5 ","12 9 875 8 1 3 9 5 1 6 1 5 47 4 3 56 7 1 2 8 5 3 6 5 2 651 3 89"," 82 54 3 9 1 49831 7 27 13 4 6 21 93 3 12587 7 9 5 38 96 "," 4 1 18 2 34 665 3 4 3562 4 7 3819 4 6 755 89 4 23 6 8 "]++hardSudokus :: [Sudoku]+hardSudokus = map (fromJust . fromString) ["35 61 2 87 4 8 9 5 6 8 4 5 1 3 4 8 3 2 5 56 1 96 34","28 5 74 796 8 1 9 8 913 142 6 7 2 8 734 76 3 89","82 65 9 7 5 2 365 7 63 1 27 8 578 3 2 7 9 28 54","43 6 92 4 3 5 2 3 79 1 1 6 6 54 7 1 8 8 7 26 2 54"," 36 74 15 32 59 7 4 3 8 317 5 5 8 1 62 59 17 47 95 "," 4 6 59 7 81 54 6 4 27 3 1 25 6 6 18 32 3 38 4 6 "," 6 39 4 1 9 6 2 6 1 4 47 652 18 5 7 9 2 9 7 5 6 82 7 "," 31 5 6 27 6 3 84 7 5 2 67 8 51 7 3 8 56 5 4 29 9 7 38 ","5 18 25 3 67 1 85 7 8 73 62 1 4 37 1 94 4 75 21 3","9 56 2 2371 5 23 6 726 1 597 8 96 1 8654 9 37 2"," 3 4 769 3 4 96 5 2 8 7 9 4 9 2 8 4 17 3 8 717 4 2 ","46 9 1 9 167 25 1 6 1 6 7 6 2 2 3 4 6 8 79 174 5 4 6 82"," 9 8 767 185 4 2 798 5 62 43 1 471 5 6 954 637 4 2 "," 37 6 2 4 9 4 53 8 9 2 3 251 8 6 4 1 85 7 4 9 7 6 18 "," 4 5 67 785 3 781 4 6 7 2 1 9 357 5 814 43 4 5 ","43 61 2 4 6 78 2 4 289 19 71 473 8 5 62 9 8 2 19 78"," 695 759 17 58 4 2 63 1 49 3 2 48 21 687 839 "," 13 7 38 97 9 4 5 76 32 1 68 39 1 3 4 73 56 2 13 "," 281 3 7 84 1 3 4 2 5 6 1 4 5 6 4 2 6 3 29 1 5 192 "," 41 8 68 9 7 1 8 45 51 46 5 18 43 69 8 5 2 6 84 1 35 ","7 4 28 49 7 56 8 484 2 9 4 3 281 5 93 6 75 87 3 2","6 3 5 2 98 18 3 6 5 1 4 5 986 7 7 2 1 8 2 56 82 1 4 1 6"," 463792 6 3 2 9 48 9 529 876 5 29 8 2 3 5 274531 ","8 71 2 4213 5 718 5 2 6 7 3 9 2 517 9 4381 1 97 5"," 7 9 5 692 71 9 3 6 6 912 3 5 182 9 7 4 1 18 926 5 6 8 "," 72 6 9 6 41 45 9 4 5 8 6 51 84 7 1 2 9 6 29 37 5 2 3 74 ","17 6 6 8 4 9415 3 9 74 6 39 1 6 7164 5 3 9 2 83"," 3 1 3 96 74 2 1 86 527 2 6 965 38 6 1 95 34 2 5 6 "," 58 76 2 3 7 1254 4 7 1 1 2 4 7169 3 4 6 47 12 "," 9 158 75 32 8 7 9 43 8 1 5 72 4 8 2 59 84 172 9 "," 3 2 3 6 78 2 5 8 96 7 6 8 6 4 7 3 39 4 5 1 63 2 8 1 9 "," 7 83 8 6 4 6 27 1 3 83 876 97 9 1 54 3 9 7 2 54 6 "," 836 9 539 9 76 1 32 2 8 64 7 76 1 356 8 247 ","7 4 6 1 8 4 43 7 3 2 75 275 486 41 7 2 4 29 9 7 3 5 8 9","571 6 2 83 9 1 78 38 2 9 8 1 96 41 9 2 47 1 9 635","6 2 47 3 8 51 59 2 3 1 9 1 4 3 6 2 51 68 2 9 53 7 9","4 6 7 7 9 8 4 1 5 298 1 3 7 6 4 2 835 1 4 1 8 5 3 4 3 2"," 7 96 2 4 1 6 85 41 529 72 67 681 92 54 7 9 4 1 76 2 ","4 67 9 46 8 5 42 1 26 2 3 1 5 6 45 3 12 5 4 49 5 41 7"," 5 8 93 74 6 8 6 9 3 7 3 14 7 21 5 8 1 3 4 8 6 91 57 2 1 "," 3 9 2 1 78 4 6 3 53 87 6 7 3 23 89 9 6 4 79 2 1 5 7 ","37 2 9 4 6 5 42 91 7 537 298 8 43 41 2 6 3 1 4 58"," 7865 2 87 1 29 49 416 2 1 854 21 24 8 79 4 7691 "," 3 7 2 58 4 316 2 1 3 4 3 2 8 7 1 4 1 8 792 3 66 1 3 5 "," 9 1 7 86 76 2 49 4 93 8 3 6 7 53 7 12 7 54 35 7 6 2 "," 7 6 4 69 3 8 2 49 63 59 4 3 25 67 54 2 7 1 79 7 2 1 "," 6 3 2 68 1 93 84 6 3 1 245 7 1 7 67 62 5 64 1 1 5 "," 1 4 43 876 534 3 7 4 9 6 8 8 4 1 6 721 189 27 7 3 ","8 1 9 3 4 461 3 9 8 27 8 5 1 26 9 4 4 915 1 3 6 3 4"," 96 7489 92 36 8 1 3 1 8 5 9 5 6 56 19 4172 31 "," 1 7 72 5 8 26 3 648 892 653 379 9 57 4 2 74 3 1 "," 8 1 8 7 95 3 3 489412 7 3 952578 3 3 16 8 4 2 5 "," 2 7 895 13 5 129 23 5 5 12 391 6 42 435 1 7 ","6 845 65 298 3 37 13 8 74 92 2 727 14 916 2","529 76 2 8 6 49 9 7 35 9 2 73 1 4 49 2 2 7 32 647"," 28 614 3 5 52 1 8 1 423 3 8 842 7 2 6 87 9 2 514 28 ","7 8 4 51 52 96 83 6 59 5 51 9 37 42 86 29 7 2 6"," 6 7 4 1 8762 6 3 5243 7 6982 8 4 9765 8 2 6 9 ","8 2 63 491 8 23 79 65 8 2 6 4 29 16 42 4 729 28 7 4"," 6 8 5 1 63 2 53 4 1 9 4 5 2 1 9 7 3 96 1 27 5 5 3 6 "," 9 26 4 3 8 2 9 8 1 5 3 2 4 1 5 5 3 6 1 4 8 7 5 1 2 46 3 ","2 96 1 82 69 5 8 284 23 81 977 9 5 17 32 6 48 3"," 72 3 4 6 9 9 685334 9 9 4 5 817948 1 7 6 5 3 24 ","62 8 9 5 8 7 249 6 5 98 34 2 6 578 3 2 7 3 8 96"," 9872614 71 63 58 46 2 1 97 85 14 18 4963872 "," 53 1 6 7 4 436 5 96 47 26 82 2 695 5 9 4 4 53 "," 65 42 21 765 3 1 6 6 48 7 6 58 1 1 7 2 541 69 46 91 ","3 4 68 9 2 1472 9 9 43 3 9 75 1 5 7389 2 8 36 4 1"," 3 8 12 2 4 1 67 8396 3 7 7 2 4 5947 98 1 9 5 26 3 9 ","7 95 19 4 2 4 2 5 1 63 4 5 63 5 1 6 2 3 4 81 18 4"," 1 47 6 7 58 9 486 5 8 3 692 6 5 8 342 9 17 3 5 62 5 "," 8 75 68 92 1 132 74 589 473 76 582 2 93 81 29 7 "," 56 4 814 9 27 7 8 4 45 7 6 89 5 8 6 81 4 293 7 14 ","795 8 3 5 614 8 7 348 1 5 876 3 8 462 6 5 2 981"," 74923 8 6 5 6 5 813 6 8 2 4 5 3 675 8 9 8 7 3 52925 ","5 3 2 1 1 7 27 95 6 5 29 196 35 8 5 43 91 8 3 3 2 5 7","9 6 8 4 1 94 6 73 8 8 6131 4643 2 8 93 4 65 6 6 7 4 2"," 4 5 9 81 3 9 2 661 7 2 8 6 9 2 138 5 7 4 43 3 5 8 "," 2 7 243 861 9 4 6 9 59 8 3 2 65 1 3 7 6 418 129 3 5 "," 9 8 5 762 1 736 84 518 5 2 624 35 319 1 649 9 5 1 "," 43 2 5 8 37 6 2 5 19 1 687 5 54 7 9 6 56 8 2 6 14 ","69 2 31 4 1 6 5 9 7 45 1 8 3 4 58 8 5 5 4 8 6 92 6 83"," 61 48 4 953 9 1 6 95 8 3 1 26 4 5 1 183 4 92 85 ","8 5 4 92 1 3 6 7 89 5 2 5 8 1 6 4 83 3 5 7 1 96 3 1 2"," 9 2 526 91 48 26 9 4 1 7 4 5 8 3 5 6 79 32 35 497 7 6 "," 73 6 143 2 41 813 524 9 7 163 858 41 6 754 6 54 "," 43 93 7 6 51 2 89 6 2 1 9 4 2 8 64 5 63 4 2 78 93 "," 46 3 796 1 2 7 148 6 9 5 7 987 4 7 6 195 6 12 ","32 4 1 9 91 2 75 62 1 5 4 2 3 97 78 5 63 9 6 8 91"," 798 9 376 8 2 1 3 9 1 6 5 9 1 8 6 6 4 7 712 3 675 ","9 3 5 1 4 9 8 3 26 8 67 7 568 9 29 8 84 6 1 5 1 8 8 3 4","93 1 7 24 63 18 4 2 1 5 164 3 3 5 6 39 64 42 9 3 87"," 8 4 3 74 1 9 93 4 7 81 3 6 5 4 19 8 2 97 3 1 52 5 6 3 ","9 3 7 6 7 6 48 4 7 4 7 1 6 8 5 3 1 4 1 6 19 3 8 5 4 9 1","3 69 21 5 618 9 58249 7 7 35218 9 716 4 17 38 4","68 93 1 56 7 821 64 9 4 18 621 8 76 5 83 16"," 2 7 9 5 397 5 4 6 9 5 7 7 964 3 8 7 9 5 6 4 187 7 2 4 6 "," 793 46 6 51 45 6 1 3 5 492 6 8 5 8 75 19 6 47 612 ","7 3 5 1 3 7 629 4 3 5 1 3 469 6 7 1 8 3 957 6 8 3 2 1 7"," 84 1 6 2792 7 4 8 81 23 51 89 6 9 5 2542 7 8 96 "]++evilSudokus :: [Sudoku]+evilSudokus = map (fromJust . fromString) [" 9 8 2 4 83 4 9 9 7 51 9 8 34 2 8 9 2 68 4 4 7 6 ","2 1 3 7 261 56 7 8 6 476 2 5 4 35 981 7 6 1 9","728 5 3 52 9 7 8 7 174 285 3 9 5 7 69 4 5 156","7 589 8 74 9 7 936 2 2 1 648 4 6 57 3 178 6"," 85 37 34 1 2 4 9 3 757 254 6 7 2 3 9 13 23 91 "," 5316 7 46 3 8 3 9 7 5 2 1 9 9 6 1 8 1 29 3 8461 ","6 1 4 5 27 4 2 3 5 6 85179 9 4 1 7 3 62 1 8 6 5","7 5 14 9 5 8 9 87 23 61 79 65 15 6 5 9 2 76 3 5"," 5 9 6 4 8 18 9 5 2 7 6 439 5 2 1 9 4 23 3 8 2 7 5 "," 7 3 412 5 3 57 4 6 8 9 5 2 3 6 4 6 32 8 3 659 4 3 "," 6 3 1 67 5 872 4 1 9 5 6 9 5 2 874 3 14 2 4 9 "," 57 3 4 1 6 82 74 6 5 6 2 8 9 7 16 49 8 6 7 9 41 "," 2 62 7 6 6 348 2 93 69 87 15 9 832 5 9 6 83 5 "," 5164 3 5 1 7 9 6 3 7 38 91 7 9 3 8 4 7 6 2 3786 "," 7 8 2 4 4 871 16 5 9 381 4 2 19 798 6 6 4 6 1 ","3 2 19 71 5 4 8 2 4 36 3 8 93 7 5 3 1 9 54 36 8 5","39 2 8 4 8 156 4 7 23 4 91 6 4 742 5 8 1 5 81"," 26 9 4 6 58 3 1 3 7 7 3 9 2 4 5 1 8 24 7 8 7 14 "," 26 7 8 3 2 1 617 3 5 3 7 9 1 5 795 7 4 5 1 9 84 ","1 4 9 7 3 5 6 1 3 26 4 3 4 5 78 9 1 2 7 8 8 1 3 6","6 97 1 4 2 75 5 9 38 4 4 2 2 16 3 2 92 5 4 7 89 3"," 4 7851 21 792 4 3 1 3 9 6 8 3 946 89 2683 9 ","1 8 3 64 7 9 2 3 85 35489 82 5 2 3 6 47 9 1 3"," 19 4 124 7 83 73 2 5 9 3 14 84 6 476 5 13 "," 2 4 5 3 9 7 2 6 4 7 538 8 4 948 1 5 8 2 2 3 5 9 1 6 "," 8 4 9 4 5 7 9 3 4 2 6 18967 7 4 5 8 3 7 6 1 2 3 6 ","58 6 4 2 138 27 147 4 8 154 32 186 3 9 2 34"," 9 5 8 5 9 6 3 95 28 7 4 7 3 9 9 25 62 7 3 6 4 2 5 1 "," 3 1 2 1 2 67 18 4 5 19 4 76 2 9 96 87 3 6 5 9 1 "," 983 71 5 6 4 1 48 6 9 5 7 3 3 25 6 7 1 9 13 543 ","85 3 49 7 4 632 7 4 9 1 6 3 9 7 137 2 3 42 7 43"," 65 74 8 691 7 8 7 1 6 3 8 2 4 8 165 9 58 32 "," 6 75 24 9 5 7 33 6 5 7 8 4 9 6 89 5 4 9 87 24 7 ","6 5 4 76 3 7 3 4 7 2 23 78 4 9 2 7 3 7 14 9 6 5"," 8 25 61 8 4 6 6 9 3 1 2 3 6 4 3 2 1 7 4 4 53 92 6 "," 2 5 724 863 8 32 5 6 1 4 45 1 975 136 1 7 ","2 5 6 5 6 1 9 5 71 5 4 36 85 2 1 63 8 4 4 7 8 7 8 9","38 4 5 12 1 2 4 5 32 4 2 3 3 51 9 4 5 8 76 1 4 35"," 1 5 946 19 2 6 3 4 4 93 15 7 2 3 5 1 98 223 5 4 "," 25 64 5 9 3 6 7 7 5 82 9 7 58 7 4 9 3 8 3 4 71 86 ","18 5 62 59 87 35 1 9 1 4 3 6 49 43 72 83 6 82"," 5 8 6 7 4 5 2 3 6 9 6 4 1 5 5 9 7 9 1 6 7 4 9 6 1 3 "," 29 86 8 4 1 75 8 35 7 8 27 2 38 9 1 3 94 21 "," 164 3 5 6 9 8 82 56 9 8 75 74 4 9 1 7 6 562 "," 63 5 8 617 2 6 218 9 7 534 8 5 936 8 4 13 ","412 78 8 3 9 9 53 75 2 9 43 64 9 1 8 6 31 928"," 389 78 1 6 9 2 9 5 7 4 8 3 3 5 7 6 7 6 4 7 15 138 "," 8 97 5 4 51 4 83 4 46 1 29 7 69 2 15 7 3 64 9 ","4 1 798 4 5 2 6 3 2 7 2 4 5 1 9 2 5 7 4 4 369 8 5"," 1 937 85 476 9 5 31 8 38 9 6 965 74 385 3 ","5 9 2 4 7 3 9 1 5 7 9 3 1 5 9 3 7 9 6 9 5 8 7 1 9 4 8 7"," 6 8 69 5 6 5 3 1 35 8 4 2 8 4 91 2 9 1 4 1 34 7 9 "," 51 6 67 4 18 1 362 8 3 392 1 78 4 35 9 13 ","3 4 2 2 47 7 12 2 6 856 718 1 3 25 7 98 2 4 6 9"," 6 12 4 5 7 3 8 7 652 2 6 631 5 9 8 7 1 9 13 4 "," 3 9 5 6 975 6 1 2 6 4 765 3 2 9 7 6 248 8 1 6 5 "," 3 578 28 93 6 1 687 438 9 2 28 91 648 2 ","39 7 51 98 8 1 4 4 9 7 6 3 2 2 9 5 37 46 9 38"," 5 679 3 581 7 34 2 7 7 1 3 42 8 734 9 561 6 ","4 6 51 33 98 17 85 97 23 94 17 49 56 29 7 1"," 3 751 7 6 5 42 4 1 67 2 4 18 7 3 42 8 8 9 725 6 "," 8 5 71 5 6 4 1 3 7 8 1 8 9 2 6 1 9 8 4 9 2 8 4 59 6 7 "," 71 57 16 65 9 3 94 8 7 9 54 5 4 72 23 88 47 "," 298 3 7 2 1 6 5 932 4 5 362 8 3 9 6 5 5 496 "," 6 3 5 98 6 7 2 3 5 8 61 94 8 6 2 2 3 5 87 7 2 9 ","97 43 1 8 5 1 1 3 9 4 6 3 7 9 8 1 3 7 9 8 2 95 61"," 4 9 365 4 7 26 287 2 5 8 641 75 3 2 973 6 4 "," 4 2 43 16 2 3 9 14 9 6 7 5 89 6 4 8 79 65 2 8 ","8 634 25 1 4 75 84 3 5 2 41 75 3 1 29 298 7","4 2 7 5 157 4 2 4 6 8 76 62 3 8 5 2 7 582 6 3 1 8"," 7 57 6 5 2 2 38 4 5 15 6 39 8 1 15 3 3 9 6 78 4 "," 7 3 5 8 46 81 7 572 81 63 571 7 51 59 7 9 8 4 ","1 5 78 2 9 342 6 25 3 9 2 38 4 715 2 8 95 8 1","7 53 41 9 2 46 5 1 3 4 7 2 7 6 5 67 8 4 21 59 4","7 2 1 9 8 64 3 67 52 1 2 82 35 9 19 5 6 3 7 5","6 71 3 9 98 5 1 2 6 6 2 4 5 6 5 9 2 5 78 3 7 46 9"," 3 9 65 436 1 3 2 5491 8737 9 3 2 987 38 5 9 "," 4 81 9 57 538 8 27 6 2 9 5 69 2 387 96 8 57 5 "," 9 6 87 6 7 1 2 4 9562 6 6287 3 4 7 3 8 28 6 3 "," 5 61 4 42 57 9 1 3 43 5 8 16 6 4 3 36 18 1 73 5 "," 8 1 6 9574 7 623 3 74 15 2 198 2 7261 3 8 9 "," 8423 19 1 6 2 1 9 32796 4 5 8 6 9 42 5743 "," 9 2 8 4 5 6 2 7 3 1 26 1 6 8 3 74 3 1 3 9 8 6 7 6 4 1 ","27 31 8 9 6 3 4 2 6 91 3 98 7 4 8 2 7 9 4 85 26"," 97 61 1 2 985 3 5 82 9 6 74 1 7 539 6 7 14 68 "," 9 6 12 2 6 7 9 51 8 34619 7 31 5 9 5 1 32 6 5 "," 2 8 4 6 93 1 285 3 7 1 2 5 9 6 619 7 78 6 5 2 8 "," 8 7 7 2 1 9 6 1 24 6 6 3 7 5 8 2 42 9 8 3 5 4 7 7 6 "," 2 6 1 6 7 8 98 3 6 9 5 3 4 6 1 5 3 48 1 2 3 6 8 5 "," 95 46 34 8 9 7 8 2 8 95 14 9 2 8 1 3 7 69 13 25 ","9 1 2 9 1 1 7 4 9 87285 64273 9 5 2 8 6 8 1 3 5"," 36 4 91 8 24 4 7 9 7 6 6 9 8 3 7 5 12 9 67 2 18 "," 47 9 8 6 675 58 9 1 36 29 9 5 38 621 3 5 7 67 "," 7 1 4 1 253 2 6497 4 9 5 3 5972 8 348 7 6 8 4 "," 83 7 25 4 82 9 3 6 7 9 1 3 5 7 9 2 84 1 64 3 26 "," 9 12 9 1 14 2 9 37 2 6 8 5 2 5 37 1 4 37 6 1 47 9 "," 3 9 4 2 6 8 2 5 39 4 6 431 2 1 25 2 9 1 7 8 6 5 3 "," 13 725 8 9 3 4 98 4 2 5 2 13 7 5 4 9 149 83 "," 3 57 4 9 1 4 9 5 46 7 8 9 2 1 21 4 9 5 7 3 6 87 2 "," 3 4 1 1 3 45 8 9 6 682 4 4 567 4 5 2 96 5 2 1 7 3 "]+
+ test/UserInterfaceSpec.hs view
@@ -0,0 +1,21 @@+module UserInterfaceSpec (main, spec) where++import qualified GI.Gtk as Gtk+import Test.Hspec+import UserInterface++-- `main` is here so that this module can be run from GHCi on its own. It is+-- -- not needed for automatic spec discovery.+main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "buildSudokuUI" $ do+ it "should actually return a UI data-structure and not fail" $ do+ _ <- Gtk.init Nothing+ ui <- buildSudokuUI "gui/hsudoku.ui"+ (length $ cells ui) `shouldSatisfy` (> 0)+ (length $ gameButtons ui) `shouldSatisfy` (> 0)+ (length $ numberButtons ui) `shouldSatisfy` (> 0)+
+ test/UtilSpec.hs view
@@ -0,0 +1,56 @@+module UtilSpec (main, spec) where++import Data.List (nub)+import Test.Hspec+import Test.QuickCheck+import Util++-- `main` is here so that this module can be run from GHCi on its own. It is+-- -- not needed for automatic spec discovery.+main :: IO ()+main = hspec spec++spec :: Spec+spec = do+ describe "nodups" $ do+ it "should return true for the empty list" $ do+ nodups ([] :: [Int]) `shouldBe` True++ it "should return true just for lists with no duplicates" $ property $+ \xs -> nodups (xs :: [Int]) == (length xs == (length $ nub xs))++ describe "groupBy" $ do+ it "should return the empty list if given an empty list" $ property $+ \n -> groupBy n ([] :: [Int]) `shouldBe` ([] :: [[Int]])++ it "should create the right amount of groups" $ property $+ \xs -> and $ map (\n ->+ let groups = length $ groupBy n (xs :: [Int])+ predicted = case xs of+ [] -> 0+ _ -> if length xs `mod` n == 0+ then length xs `div` n+ else 1 + length xs `div` n+ in groups == predicted) [1..10]++ it "should create the right group sizes" $ property $+ \xs -> and $ map (\n ->+ let sizes = map length $ groupBy n (xs :: [Int])+ in all (<= n) sizes+ ) [1..10]++ describe "ungroup" $ do+ it "should return the empty list if given an empty list" $ property $+ ungroup ([] :: [[Int]]) `shouldBe` ([] :: [Int])++ it "should contain the same elements" $ property $+ \xxs -> ungroup (xxs :: [[Int]]) == concat xxs++ describe "single" $ do+ it "should be true if and only the list contains one element" $ property $+ \xs -> single (xs :: [Int]) `shouldBe` (length xs == 1)++ describe "delete" $ do+ it "should not contain the deleted elements" $ property $+ \xs ys -> delete xs (xs ++ ys) == (ys :: [Int])+