puzzle-draw 0.1.0.0 → 0.1.0.1

raw patch · 17 files changed

+211/−322 lines, 17 filesPVP: minor bump suggested

API additions: PVP suggests at least a minor version bump

API changes (from Hackage documentation)

Files

• CHANGES.md +9/−0
• README.md +58/−0
• puzzle-draw.cabal +2/−39
• src/Data/Puzzles/Compose.hs +2/−1
• src/Data/Puzzles/Elements.hs +3/−0
• src/Data/Puzzles/Grid.hs +2/−1
• src/Data/Puzzles/PuzzleTypes.hs +2/−0
• src/Diagrams/Puzzles/Draw.hs +1/−1
• src/Diagrams/Puzzles/Elements.hs +16/−1
• src/Diagrams/Puzzles/Grid.hs +1/−1
• src/Diagrams/Puzzles/Lib.hs +1/−1
• src/Diagrams/Puzzles/PuzzleGrids.hs +1/−0
• src/Diagrams/Puzzles/PuzzleTypes.hs +10/−1
• src/Diagrams/Puzzles/Pyramid.hs +1/−0
• src/Text/Puzzles/PuzzleTypes.hs +5/−1
• src/Text/Puzzles/Util.hs +11/−4
• tests/tests.hs +86/−271

@@ -0,0 +1,9 @@+0.1.0.1: 20140409+-----------------++* add new puzzle type: Tapa++0.1.0.0+-------++* first release

@@ -0,0 +1,58 @@+[![Build Status](https://api.travis-ci.org/robx/puzzle-draw.png)][travis]++puzzle-draw+===========++puzzle-draw is a library for drawing pencil puzzles using +[Diagrams][diagrams]. It aims to provide a utility layer on top of +Diagrams to help with drawing arbitrary puzzles, as well as supporting +several specific puzzle types directly. In addition, it includes +functionality for parsing puzzle data from a YAML file format.++See [puzzle-draw-cmdline][cmdline] for a command line tool that+uses this.++Examples+--------++A [liar slitherlink][liarslither] with solution:++![Liar Slitherlink](doc/slitherlink-liar-example.png)++This was rendered from the following YAML document:++```+type: slitherlinkliar+puzzle: |+  1..0.3+  .03222+  0....1+  3....3+  32202.+  3.3..3+solution:+  loop: |+    .┌──┐┌┐+    .│┌─┘││+    .│└──┘│+    ┌┘.┌─┐│+    └┐┌┘.││+    ┌┘│..││+    └─┘..└┘+  liars: |+    ...X..+    .X....+    X.....+    .....X+    ....X.+    ..X...+```++Or see a [puzzle set][twentyfour] that covers the puzzle types+that are supported currently.++[travis]: http://travis-ci.org/robx/puzzle-draw+[cmdline]: http://github.com/robx/puzzle-draw-cmdline+[liarslither]: http://maybepuzzles.wordpress.com/types/liar-slither-link/+[twentyfour]: http://maybepuzzles.wordpress.com/2014/03/29/puzzle-set-24-hour-marathon/+[diagrams]: http://projects.haskell.org/diagrams/

@@ -1,21 +1,6 @@--- Initial puzzle-draw.cabal generated by cabal init.  For further --- documentation, see http://haskell.org/cabal/users-guide/---- The name of the package. name:                puzzle-draw---- The package version.  See the Haskell package versioning policy (PVP) --- for standards guiding when and how versions should be incremented.--- http://www.haskell.org/haskellwiki/Package_versioning_policy--- 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.+version:             0.1.0.1 synopsis:            Creating graphics for pencil puzzles.---- A longer description of the package. description:         puzzle-draw is a library for drawing pencil puzzles                      using Diagrams. It aims to provide a utility layer                      on top of Diagrams to help with drawing arbitrary@@ -23,35 +8,18 @@                      puzzle types directly. In addition, it includes                      functionality for parsing puzzle data from a                      YAML file format.---- The license under which the package is released. license:             MIT---- The file containing the license text. license-file:        LICENSE---- The package author(s). author:              Robert Vollmert---- An email address to which users can send suggestions, bug reports, and --- patches. maintainer:          rfvollmert@gmail.com---- A copyright notice.--- copyright:           - category:            Graphics- build-type:          Simple---- Constraint on the version of Cabal needed to build this package.+Extra-source-files:  README.md, CHANGES.md cabal-version:       >=1.8 Source-repository head   type:     git   location: http://github.com/robx/puzzle-draw.git- library-  -- Modules exported by the library.   exposed-modules:     Data.Puzzles.Grid                        Data.Puzzles.GridShape                        Data.Puzzles.Elements@@ -70,11 +38,6 @@                        Diagrams.Puzzles.PuzzleGrids                        Diagrams.Puzzles.PuzzleTypes                        Diagrams.Puzzles.Draw-  -  -- Modules included in this library but not exported.-  -- other-modules:       -  -  -- Other library packages from which modules are imported.   build-depends:       base >= 4.2 && < 4.8,                        diagrams-lib >= 1.1 && < 1.2,                        parsec >= 3.1 && < 3.2,

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, RankNTypes #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, RankNTypes #-}  -- | -- Helpers to string together parser and renderer by puzzle type.@@ -60,6 +60,7 @@ handle f BoxOf2Or3            = f R.boxof2or3           D.boxof2or3 handle f AfternoonSkyscrapers = f R.afternoonskyscrapers D.afternoonskyscrapers handle f CountNumbers         = f R.countnumbers        D.countnumbers+handle f Tapa                 = f R.tapa                D.tapa  -- | Handler that parses a puzzle from a YAML value, and renders. drawPuzzle :: PuzzleHandler b (Value -> Parser (Diagram b R2))

@@ -52,3 +52,6 @@  data KropkiDot = None | Black | White     deriving Show++newtype TapaClue = TapaClue [Int]+    deriving Show

@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleContexts, GADTs, StandaloneDeriving #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts,+             GADTs, StandaloneDeriving #-}  -- | Puzzle grids. module Data.Puzzles.Grid where

@@ -34,6 +34,7 @@                 | BoxOf2Or3                 | AfternoonSkyscrapers                 | CountNumbers+                | Tapa     deriving (Show, Eq)  typeNames :: [(PuzzleType, String)]@@ -60,6 +61,7 @@             , (BoxOf2Or3, "boxof2or3")             , (AfternoonSkyscrapers, "afternoonskyscrapers")             , (CountNumbers, "countnumbers")+            , (Tapa, "tapa")             ]  -- | Look up a puzzle type by name.

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}  module Diagrams.Puzzles.Draw (     PuzzleSol,

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts #-}  -- | Module: Diagrams.TwoD.Puzzles.Elements --@@ -141,3 +141,18 @@         [ (0, 0), (1/4, 1/4), (1, 1/4), (1, 0), (0, 0) ]     south = strokeLocLoop shape # lw 0 # fc gray     west = reflectAbout (p2 (0, 0)) (r2 (1, 1)) south++drawTapaClue :: (Backend b R2, Renderable (Path R2) b) =>+                TapaClue -> Diagram b R2+drawTapaClue (TapaClue [x]) = drawInt x+drawTapaClue (TapaClue xs)  = fit 0.8+                            . decoratePath (p (length xs))+                            . map drawInt+                            $ xs+  where+    p n = centerXY (p' n)+    p' 2 = p2 (-1/4, 1/4) ~~ p2 (1/4, -1/4)+    p' 3 = reflectX . rotate (1/6 @@ turn) $ triangle 0.8+    p' 4 = rotate (1/8 @@ turn) $ square 0.7+    p' 1 = error "singleton clues handled separately"+    p' _ = error "invalid tapa clue"

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, TypeFamilies #-}  module Diagrams.Puzzles.Grid where 

@@ -1,4 +1,4 @@-{-# LANGUAGE FlexibleContexts, TypeFamilies #-}+{-# LANGUAGE MultiParamTypeClasses, FlexibleContexts, TypeFamilies #-}  module Diagrams.Puzzles.Lib where 

@@ -1,3 +1,4 @@+{-# LANGUAGE MultiParamTypeClasses     #-} {-# LANGUAGE FlexibleContexts          #-} {-# LANGUAGE TypeFamilies              #-} 

@@ -1,3 +1,4 @@+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-}  module Diagrams.Puzzles.PuzzleTypes (@@ -5,7 +6,7 @@     sudoku, thermosudoku, pyramid, kpyramid, slither,     liarslither, tightfitskyscrapers, wordloop, wordsearch,     curvedata, doubleback, slalom, compass, boxof2or3,-    afternoonskyscrapers, countnumbers,+    afternoonskyscrapers, countnumbers, tapa,   ) where  import Diagrams.Prelude hiding (Loop)@@ -177,3 +178,11 @@ countnumbers = (,)     drawAreaGrid     (drawIntGrid . snd <> drawAreaGrid . fst)++tapa :: (Backend b R2, Renderable (Path R2) b) =>+        RenderPuzzle b (SGrid TapaClue) ShadedGrid+tapa = (,)+    tapaGrid+    (tapaGrid . fst <> drawShadedGrid . snd)+  where+    tapaGrid = atCentres drawTapaClue . values <> grid . size

@@ -1,3 +1,4 @@+{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleContexts #-}  module Diagrams.Puzzles.Pyramid where

@@ -5,7 +5,7 @@     sudoku, thermosudoku, pyramid, kpyramid, slither,     liarslither, tightfitskyscrapers, wordloop, wordsearch,     curvedata, doubleback, slalom, compass, boxof2or3,-    afternoonskyscrapers, countnumbers,+    afternoonskyscrapers, countnumbers, tapa,   ) where  import Prelude hiding (sequence)@@ -121,3 +121,7 @@ -- this should be changed to support clue numbers countnumbers :: ParsePuzzle AreaGrid IntGrid countnumbers = (parseGrid, parseGrid)++tapa :: ParsePuzzle (SGrid TapaClue) ShadedGrid+tapa = (\v -> unRG <$> parseJSON v,+        parseShadedGrid)

@@ -126,15 +126,19 @@     parseChar _   = empty  data Blank = Blank+data Blank' = Blank'  instance FromChar Blank where     parseChar '.' = pure Blank-    parseChar '-' = pure Blank     parseChar _   = empty +instance FromChar Blank' where+    parseChar '.' = pure Blank'+    parseChar '-' = pure Blank'+    parseChar _   = empty+ instance FromString Blank where     parseString "." = pure Blank-    parseString "-" = pure Blank     parseString _   = empty  instance FromChar SlalomDiag where@@ -308,7 +312,7 @@                                       SGrid (Tightfit ())) parseTightOutside v = do     BorderedRect w h ls b <- parseJSON v-        :: Parser (BorderedRect Tight (Either Blank Int))+        :: Parser (BorderedRect Tight (Either Blank' Int))     return (outside . fmap (either (const Nothing) Just) $ b,             fmap unTight . rectToSGrid $ Rect w h ls)   where outside (Border l r b t) = OC l r b t@@ -393,4 +397,7 @@     splitBorder (Square w h) = Map.partitionWithKey         (\(x, y) _ -> x < w - 1 && y < h - 1) -+instance FromJSON TapaClue where+    parseJSON v = do xs <- parseJSON v+                     guard $ length xs > 0 && length xs <= 4+                     return $ TapaClue xs

@@ -2,12 +2,11 @@ import Test.Tasty.HUnit  import Data.Yaml-import qualified Data.ByteString.Char8 as B-import Data.Maybe (fromJust) import Data.List (sort)  import Control.DeepSeq +import Text.Puzzles.Puzzle import Data.Puzzles.Elements (Thermometer) import Text.Puzzles.Util (parseChar) import Text.Puzzles.PuzzleTypes@@ -19,251 +18,78 @@ import Diagrams.Backend.SVG  import Text.Blaze.Svg.Renderer.Text (renderSvg)-import qualified Data.Text as T +import Data+import Util+ main :: IO () main = defaultMain tests  tests :: TestTree-tests = testGroup "Tests" [unitTests]--decodeLines :: [String] -> Value-decodeLines = fromJust . decode . B.pack . unlines--packLine :: String -> Value-packLine = String . T.pack--packLines :: [String] -> Value-packLines = String . T.pack . unlines--geradeweg_1 :: Value-geradeweg_1 = packLines $-    [ ".....    "-    , ".211."-    , "..2..  "-    , "3...4"-    , "....."-    ]--geradeweg_1_sol :: Value-geradeweg_1_sol = packLines $-    [ "┌┐┌─┐"-    , "││└┐│  "-    , "│└─┘│"-    , "└──┐│"-    , "  .└┘ "-    ]--tightfit_1 :: Value-tightfit_1 = packLines $-    [ " --- "-    , "3/\\.-"-    , "-\\.\\4"-    , "-.\\/-"-    , " 35-"-    ]--tightfit_broken_1 :: Value-tightfit_broken_1 = packLines $-    [ " --- "-    , "3/\\.-"-    , "-\\x\\4"-    , "-.\\/-"-    , " 35-"-    ]--tightfit_broken_2 :: Value-tightfit_broken_2 = packLines $-    [ "3/\\.-"-    , "-\\x\\4"-    , "-.\\/-"-    , " 35-"-    ]--tightfit_1_sol :: Value-tightfit_1_sol = packLines $-    [ "2/1 4\\5  3"-    , "  4\\5  3  2\\1 "-    , "   3  1\\2 5/4"-    ]--tightfit_sol_broken :: Value-tightfit_sol_broken = packLine "2/1 4 /5"--tightfit_sol_broken_2 :: Value-tightfit_sol_broken_2 = packLine "2/x 4 3/5"--slalom_sol_broken :: Value-slalom_sol_broken = packLine "//\\ /\\x5 "--kpyramid_1 :: Value-kpyramid_1 = packLines $-    [ "G     3"-    , "G    . ."-    , "G   . . ."-    , "W  .o. . ."-    , "G 1*.*.o.*6"-    ]--kpyramid_1_sol :: Value-kpyramid_1_sol = packLines $-    [ "    3"-    , "   8 5"-    , "  1 9 4"-    , " 3 2 7 3"-    , "1 2 4 3 6"-    ]--kpyramid_broken_1 :: Value-kpyramid_broken_1 = packLines $-    [ "  G     3"-    , "  G    . 22"-    , "  H   . aa ."-    , "  W  .o. .|. "-    , "  G 1*.*.o.*6"-    ]--kpyramid_broken_2 :: Value-kpyramid_broken_2 = packLines $-    [ "G     3"-    , "G    . 22"-    , "H   . aa ."-    , "W  .o. .|. "-    , "G 1*.*.o.*6"-    ]--kpyramid_broken_3 :: Value-kpyramid_broken_3 = packLines $-    [ "G     3"-    , "G    . ."-    , "G   . . ."-    , "W  .o. . ."-    , "G a*.*.o.*6"-    ]--compass_1 :: Value-compass_1 = decodeLines $-    [ "grid: |"-    , "  ..."-    , "  a.b"-    , "clues:"-    , "  a: 2 1 . 2"-    , "  b: 21 . . 0"-    ]--compass_broken_1 :: Value-compass_broken_1 = decodeLines $-    [ "grid: |"-    , "  a.b"-    , "clues:"-    , "  b: 21 . . 0"-    ]--compass_broken_2 :: Value-compass_broken_2 = decodeLines $-    [ "grid: |"-    , "  a.b"-    , "clues:"-    , "  a: x . . 0"-    , "  b: 21 . . 0"-    ]--compass_broken_3 :: Value-compass_broken_3 = decodeLines $-    [ "grid: |"-    , "  a.b"-    , "clues:"-    , "  a: 1 . ."-    , "  b: 21 . . 0"-    ]+tests = testGroup "Tests"+    [ parseUtilTests, parseTests, parseDataTests, renderTests ] -compass_broken_4 :: Value-compass_broken_4 = decodeLines $-    [ "grid: |"-    , "  a.b"-    , "clues:"-    , "  a: 1 . . 2 3"-    , "  b: 21 . . 0"-    ]+testParsePzl, testParseSol, testNonparsePzl, testNonparseSol ::+    (Show a, Show b) => String -> ParsePuzzle a b -> Value -> TestTree+testParsePzl name parser yaml =+    testCase ("parse " ++ name) $ testParse (fst parser) yaml+testParseSol name parser yaml =+    testCase ("parse " ++ name ++ " (sol)") $ testParse (snd parser) yaml+testNonparsePzl name parser yaml =+    testCase ("don't parse broken " ++ name) $ testNonparse (fst parser) yaml+testNonparseSol name parser yaml =+    testCase ("don't parse broken " ++ name ++ " (sol)") $+        testNonparse (snd parser) yaml -compass_broken_5 :: Value-compass_broken_5 = decodeLines $-    [ "grid: |"-    , "  a3b"-    , "clues:"-    , "  a: 1 . . 2 3"-    , "  b: 21 . . 0"+parseUtilTests :: TestTree+parseUtilTests = testGroup "Parsing infrastructure tests (parseChar)"+    [ testCase "parse digit" $+        (parseMaybe parseChar '5' :: Maybe Int) @=? Just 5+    , testCase "don't parse hex chars" $+        (parseMaybe parseChar 'a' :: Maybe Int) @=? Nothing+    , testCase "don't break on non-digits" $+        (parseMaybe parseChar ' ' :: Maybe Int) @=? Nothing     ] -thermo_1 :: Value-thermo_1 = packLines $-    [ ".b..2."-    , "a.c5.1"-    , ".d..6."-    , ".4..c."-    , "5.3b.d"-    , ".2..a."+parseTests :: TestTree+parseTests = testGroup "Parsing tests (full puzzles, no details)"+    [ testParsePzl "geradeweg" geradeweg geradeweg_1+    , testParseSol "geradeweg" geradeweg geradeweg_1_sol+    , testParsePzl "tightfit"  tightfitskyscrapers tightfit_1+    , testParseSol "tightfit"  tightfitskyscrapers tightfit_1_sol+    , testNonparsePzl "tightfit" tightfitskyscrapers tightfit_broken_1+    , testNonparsePzl "tightfit" tightfitskyscrapers tightfit_broken_2+    , testNonparseSol "tightfit" tightfitskyscrapers tightfit_sol_broken+    , testNonparseSol "tightfit" tightfitskyscrapers tightfit_sol_broken_2+    , testNonparseSol "slalom" slalom slalom_sol_broken+    , testParsePzl "kpyramid" kpyramid kpyramid_1+    , testParseSol "kpyramid" kpyramid kpyramid_1_sol+    , testNonparsePzl "kpyramid" kpyramid kpyramid_broken_1+    , testNonparsePzl "kpyramid" kpyramid kpyramid_broken_2+    , testNonparsePzl "kpyramid" kpyramid kpyramid_broken_3+    , testParsePzl "compass" compass compass_1+    , testNonparsePzl "compass" compass compass_broken_1+    , testNonparsePzl "compass" compass compass_broken_2+    , testNonparsePzl "compass" compass compass_broken_3+    , testNonparsePzl "compass" compass compass_broken_4+    , testNonparsePzl "compass" compass compass_broken_5+    , testParsePzl "thermosudoku" thermosudoku thermo_1+    , testParsePzl "thermosudoku" thermosudoku thermo_2+    , testNonparsePzl "thermosudoku" thermosudoku thermo_broken_1+    , testNonparsePzl "thermosudoku" thermosudoku thermo_broken_2     ]  test_thermo_1 :: [Thermometer]-test_thermo_1 = either (const []) snd res-  where-    res = parseEither (fst thermosudoku) thermo_1+test_thermo_1 = either (const []) snd $+                parseEither (fst thermosudoku) thermo_1  -- two neighbouring a's, should be fine-thermo_2 :: Value-thermo_2 = packLines $-    [ "....2."-    , "..c5.1"-    , ".b..6."-    , "a..c.."-    , "a...b."-    , ".bc.a."-    ]- test_thermo_2 :: [Thermometer]-test_thermo_2 = either (const []) snd res-  where-    res = parseEither (fst thermosudoku) thermo_2--thermo_broken_1 :: Value-thermo_broken_1 = packLines $-    [ ".."-    , "a."-    ]--thermo_broken_2 :: Value-thermo_broken_2 = packLines $-    [ "bb"-    , "a."-    ]--justShow :: Show a => Maybe a -> Bool-justShow Nothing = False-justShow (Just x) = show x `deepseq` True--eitherShow :: Show a => Either e a -> Bool-eitherShow (Left _) = False-eitherShow (Right x) = show x `deepseq` True--testParse :: Show a => (Value -> Parser a) -> Value -> Assertion-testParse p t = eitherShow res @? "bad parse: " ++ err-  where-    res = parseEither p t-    err = either id (const "no error") res--testNonparse :: Show a => (Value -> Parser a) -> Value -> Assertion-testNonparse p t = (not . justShow . parseMaybe p $ t)-                   @? "parsed but shouldn't"+test_thermo_2 = either (const []) snd $+                parseEither (fst thermosudoku) thermo_2 -testBreakSlalom :: Bool-testBreakSlalom =-    case parseMaybe (snd slalom) slalom_sol_broken of-        Nothing -> True-        Just s  -> let d = drawSlalomDiags s-                       svg = renderDia SVG (SVGOptions (Width 100) Nothing) d-                       svgt = renderSvg svg-                   in (show svgt) `deepseq` True+testThermo :: [Thermometer] -> [Thermometer] -> Assertion+testThermo t expect = sort t @?= expect  test_tightfit_1 :: Bool test_tightfit_1 = either (const False) test_both res@@ -280,46 +106,35 @@ test_pyramid_sol = either (const False) test_content res   where     res = parseEither (snd kpyramid) kpyramid_1_sol-    test_content (PyramidSol rs) = rs == [[3], [8,5], [1,9,4], [3,2,7,3], [1,2,4,3,6]]+    test_content (PyramidSol rs) =+        rs == [[3], [8,5], [1,9,4], [3,2,7,3], [1,2,4,3,6]] -unitTests :: TestTree-unitTests = testGroup "Unit tests"-    [ testCase "parse geradeweg" $ testParse (fst geradeweg) geradeweg_1-    , testCase "parse geradeweg solution" $ testParse (snd geradeweg) geradeweg_1_sol-    , testCase "parse tightfit" $ testParse (fst tightfitskyscrapers) tightfit_1-    , testCase "parse tightfit, correct size" $ test_tightfit_1 @? "error in puzzle"-    , testCase "parse tightfit solution" $ testParse (snd tightfitskyscrapers) tightfit_1_sol-    , testCase "don't parse broken tighfit" $ testNonparse (fst tightfitskyscrapers) tightfit_broken_1-    , testCase "don't parse broken tighfit" $ testNonparse (fst tightfitskyscrapers) tightfit_broken_2-    , testCase "don't parse broken tightfit solution" $-        testNonparse (snd tightfitskyscrapers) tightfit_sol_broken-    , testCase "don't parse broken tightfit solution" $-        testNonparse (snd tightfitskyscrapers) tightfit_sol_broken_2-    , testCase "parse digit" $ (parseMaybe parseChar '5' :: Maybe Int) @=? Just 5-    , testCase "don't parse hex chars" $ (parseMaybe parseChar 'a' :: Maybe Int) @=? Nothing-    , testCase "don't break on non-digits" $ (parseMaybe parseChar ' ' :: Maybe Int) @=? Nothing-    , testCase "don't parse invalid slalom solution" $ testNonparse (snd slalom) slalom_sol_broken-    , testCase "don't break rendering invalid slalom solution"-         $ testBreakSlalom @? "just testing against errors"-    , testCase "parse kpyramid" $ testParse (fst kpyramid) kpyramid_1-    , testCase "parse kpyramid sol" $ testParse (snd kpyramid) kpyramid_1_sol+parseDataTests :: TestTree+parseDataTests = testGroup "Parsing tests (full puzzles, result checks)"+    [ testCase "parse tightfit, correct size" $ test_tightfit_1 @? "error in puzzle"     , testCase "parse kpyramid sol properly" $ test_pyramid_sol @? "wrong solution"-    , testCase "don't parse broken kpyramid" $ testNonparse (fst kpyramid) kpyramid_broken_1-    , testCase "don't parse broken kpyramid" $ testNonparse (fst kpyramid) kpyramid_broken_2-    , testCase "don't parse broken kpyramid" $ testNonparse (fst kpyramid) kpyramid_broken_3-    , testCase "parse compass" $ testParse (fst compass) compass_1-    , testCase "don't parse borken compass" $ testNonparse (fst compass) compass_broken_1-    , testCase "don't parse borken compass" $ testNonparse (fst compass) compass_broken_2-    , testCase "don't parse borken compass" $ testNonparse (fst compass) compass_broken_3-    , testCase "don't parse borken compass" $ testNonparse (fst compass) compass_broken_4-    , testCase "don't parse borken compass" $ testNonparse (fst compass) compass_broken_5-    , testCase "parse thermo" $ testParse (fst thermosudoku) thermo_1-    , testCase "parse thermo" $ testParse (fst thermosudoku) thermo_2-    , testCase "parse thermo, thermometers" $ sort test_thermo_1 @?= [ [(0, 4), (1, 5), (2, 4), (1, 3)]-                                                                     , [(4, 0), (3, 1), (4, 2), (5, 1)] ]-    , testCase "parse thermo, thermometers" $ sort test_thermo_2 @?= [ [(0, 1), (1, 0), (2, 0)]-                                                                     , [(0, 2), (1, 3), (2, 4)]-                                                                     , [(4, 0), (4, 1), (3, 2)] ]-    , testCase "don't parse broken thermo" $ testNonparse (fst thermosudoku) thermo_broken_1-    , testCase "don't parse broken thermo" $ testNonparse (fst thermosudoku) thermo_broken_2+    , testCase "parse thermos" $ testThermo test_thermo_1+                                            [ [(0, 4), (1, 5), (2, 4), (1, 3)]+                                            , [(4, 0), (3, 1), (4, 2), (5, 1)] ]+    , testCase "parse thermos" $ testThermo test_thermo_2+                                            [ [(0, 1), (1, 0), (2, 0)]+                                            , [(0, 2), (1, 3), (2, 4)]+                                            , [(4, 0), (4, 1), (3, 2)] ]+    ]++-- this used to cause a rendering crash, though it's+-- caught by parsing by now+testBreakSlalom :: Bool+testBreakSlalom =+    case parseMaybe (snd slalom) slalom_sol_broken of+        Nothing -> True+        Just s  -> let d = drawSlalomDiags s+                       svg = renderDia SVG (SVGOptions (Width 100) Nothing) d+                       svgt = renderSvg svg+                   in (show svgt) `deepseq` True++renderTests :: TestTree+renderTests = testGroup "Rendering tests"+    [ testCase "don't break rendering invalid slalom solution"+         $ testBreakSlalom @? "just testing against errors"     ]