ca-patterns 0.1.0.0 → 0.2.0.0

raw patch · 11 files changed

+627/−39 lines, 11 filesdep +ca-patternsdep +hspecdep ~basedep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies added: ca-patterns, hspec

Dependency ranges changed: base, vector

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−1
• README.md +3/−1
• ca-patterns.cabal +24/−2
• src/Data/CA/List.hs +2/−2
• src/Data/CA/Pattern.hs +25/−25
• src/Text/RLE.hs +20/−8
• test/Data/CA/ListSpec.hs +21/−0
• test/Data/CA/PatternSpec.hs +198/−0
• test/Spec.hs +1/−0
• test/TestPatterns.hs +263/−0
• test/Text/RLESpec.hs +58/−0

@@ -1,5 +1,16 @@ # Revision history for ca-patterns -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.0.0 -- 2022-03-17  * First version. Released on an unsuspecting world.++## 0.2.0.0 -- 2022-04-15++* `Cell` is now an alias for `Bool`.+* Added `parseMany` function to `Text.RLE`.+* Added `Eq` and `Show` instances for `Pattern`.+* `trimLeft` and `trimRight` no longer recurse infinitely when given+the empty pattern.+* `setDimensions` creates a grid of dead cells when given the empty pattern.+* RLE parser returns width and height in the correct order.+* Added test suite.

@@ -1,2 +1,4 @@ # ca-patterns-Data types for life-like cellular automata, functions for creating and parsing RLE files+Manipulate patterns in cellular automata. Create and parse RLE files.++Documentation is available on [Hackage](https://hackage.haskell.org/package/ca-patterns-0.1.0.0).

@@ -1,6 +1,6 @@ cabal-version: 2.4 name:          ca-patterns-version:       0.1.0.0+version:       0.2.0.0 author:        Owen Bechtel maintainer:    ombspring@gmail.com @@ -24,6 +24,10 @@   location: https://github.com/UnaryPlus/ca-patterns.git  library+    hs-source-dirs:   src+    default-language: Haskell2010+    ghc-options:      -Wall+     exposed-modules:       Data.CA.Pattern,       Data.CA.List,@@ -35,6 +39,24 @@       text >= 0.7 && < 2.1,       parsec >= 3.1.6 && < 3.2 +test-suite test+    type:             exitcode-stdio-1.0+    hs-source-dirs:   test     default-language: Haskell2010     ghc-options:      -Wall-    hs-source-dirs:   src+    main-is:          Spec.hs++    other-modules:+      Data.CA.PatternSpec,+      Data.CA.ListSpec,+      Text.RLESpec,+      TestPatterns++    build-depends:+      base,+      vector,+      hspec,+      ca-patterns++    build-tool-depends:+      hspec-discover:hspec-discover

@@ -3,7 +3,7 @@ import qualified Control.Applicative as Ap  import qualified Data.CA.Pattern as Pat-import Data.CA.Pattern (Pattern, Cell(..))+import Data.CA.Pattern (Pattern, Cell)  composeN :: Int -> (a -> a) -> a -> a composeN n f@@ -11,7 +11,7 @@   | otherwise = f . composeN (n - 1) f  possible1 :: Int -> [[Cell]]-possible1 n = composeN n (Ap.liftA2 (:) [Dead, Alive]) [[]]+possible1 n = composeN n (Ap.liftA2 (:) [False, True]) [[]]  possible2 :: Int -> Int -> [[[Cell]]] possible2 h w = let

@@ -7,7 +7,7 @@  module Data.CA.Pattern   ( -- * Cells-    Cell(..), isDead, isAlive+    Cell     -- * Patterns   , Pattern, lookup, generate, height, width, dimensions, valid     -- * Vector conversions@@ -55,31 +55,29 @@  firstCell :: Vector Cell -> Cell firstCell row-  | Vec.null row = Dead+  | Vec.null row = False   | otherwise = Vec.head row  lastCell :: Vector Cell -> Cell lastCell row-  | Vec.null row = Dead+  | Vec.null row = False   | otherwise = Vec.last row  {-|-The state of a cell.+The state of a cell. 'True' represents a live cell and+'False' represents a dead cell. -}-data Cell = Dead | Alive-  deriving (Eq, Ord, Show)--isDead :: Cell -> Bool-isDead = \case { Dead -> True; Alive -> False }--isAlive :: Cell -> Bool-isAlive = \case { Dead -> False; Alive -> True }+type Cell = Bool  {-| A pattern in a 2-dimensional 2-state cellular automaton. -} newtype Pattern = Pattern (Vector (Vector Cell))+  deriving (Eq) +instance Show Pattern where+  show pat = "fromList " ++ show (toList pat)+ transform :: (Vector (Vector Cell) -> Vector (Vector Cell)) -> Pattern -> Pattern transform f (Pattern rows) = Pattern (f rows) @@ -87,13 +85,13 @@ Get the state of one of the cells in a pattern. @lookup 0 0@ returns the cell in the upper-left corner. If the row or column number is out of range, this function will-return 'Dead'.+return 'False'. -} lookup   :: Int -- ^ row   -> Int -- ^ column   -> Pattern -> Cell-lookup r c (Pattern rows) = Maybe.fromMaybe Dead (rows !? r >>= (!? c))+lookup r c (Pattern rows) = Maybe.fromMaybe False (rows !? r >>= (!? c))  {-| Generate a pattern from a function.@@ -146,7 +144,7 @@ fromVector :: Vector (Vector Cell) -> Pattern fromVector rows = let   maxWidth = foldr (max . Vec.length) 0 rows-  padded = fmap (padEnd maxWidth Dead) rows+  padded = fmap (padEnd maxWidth False) rows   in Pattern padded  {-|@@ -179,7 +177,7 @@  toSomeString :: (Monoid s, IsString s) => (Vector Char -> s) -> Char -> Char -> Pattern -> s toSomeString makeStr dead alive (Pattern rows) = let-  toChar = \case { Dead -> dead; Alive -> alive }+  toChar cell = if cell then alive else dead   makeLine row = makeStr (fmap toChar row) <> "\n"   in foldMap makeLine rows @@ -209,22 +207,24 @@ Remove rows of dead cells from the top of a pattern. -} trimTop :: Pattern -> Pattern-trimTop = transform (Vec.dropWhile (all isDead))+trimTop = transform (Vec.dropWhile (all not))  {-| Remove rows of dead cells from the bottom of a pattern. -} trimBottom :: Pattern -> Pattern-trimBottom = transform (dropWhileEnd (all isDead))+trimBottom = transform (dropWhileEnd (all not))  trimLeftV :: Vector (Vector Cell) -> Vector (Vector Cell) trimLeftV rows-  | all (isDead . firstCell) rows = trimLeftV (fmap dropFirst rows)+  | Vec.null rows || any Vec.null rows = rows+  | not (any firstCell rows) = trimLeftV (fmap dropFirst rows)   | otherwise = rows  trimRightV :: Vector (Vector Cell) -> Vector (Vector Cell) trimRightV rows-  | all (isDead . lastCell) rows = trimRightV (fmap dropLast rows)+  | Vec.null rows || any Vec.null rows = rows+  | not (any lastCell rows) = trimRightV (fmap dropLast rows)   | otherwise = rows  {-|@@ -234,7 +234,7 @@ trimLeft = transform trimLeftV  {-|-You get the idea.+Remove columns of dead cells from the right side of a pattern. -} trimRight :: Pattern -> Pattern trimRight = transform trimRightV@@ -257,11 +257,11 @@     LT -> transform (Vec.take h) pat     EQ -> pat     GT -> let-      row = Vec.replicate (width pat) Dead+      row = Vec.replicate (width pat) False       in transform (padEnd h row) pat  {-|-Force a pattern to have the given width by remove columns+Force a pattern to have the given width by removing columns from the right or by adding columns of dead cells. -} setWidth :: Int -> Pattern -> Pattern@@ -269,13 +269,13 @@   case compare w (width pat) of     LT -> transform (fmap (Vec.take w)) pat     EQ -> pat-    GT -> transform (fmap (padEnd w Dead)) pat+    GT -> transform (fmap (padEnd w False)) pat  {-| Set the height and width of a pattern. -} setDimensions :: Int -> Int -> Pattern -> Pattern-setDimensions h w = setHeight h . setWidth w+setDimensions h w = setWidth w . setHeight h  {-| Reflect vertically, switching the top and the bottom.

@@ -26,9 +26,10 @@ for more information. -} +{-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# LANGUAGE BlockArguments, LambdaCase, OverloadedStrings, FlexibleContexts #-} -module Text.RLE (Rule, parse, make, printAll) where+module Text.RLE (Rule, parse, parseMany, make, printAll) where  import qualified Data.Char as Char import qualified Data.String as String@@ -43,6 +44,7 @@   )  import qualified Data.Text.IO as IO+import Data.Text(Text)  import qualified Data.CA.Pattern as Pat import Data.CA.Pattern (Pattern)@@ -85,7 +87,7 @@   return rule  parseHeader :: (Stream s Identity Char) => Parser s Header-parseHeader = Ap.liftA3 Header parseWidth parseHeight maybeRule+parseHeader = Ap.liftA3 (flip Header) parseWidth parseHeight maybeRule   where maybeRule = fmap Just parseRule <|> return Nothing  parseRunType :: (Stream s Identity Char) => Parser s RunType@@ -98,7 +100,7 @@  parseData :: (Stream s Identity Char) => Parser s RLEData parseData = do-  rle <- Ap.liftA2 (,) parseHeader (many1 parseRun)+  rle <- Ap.liftA2 (,) parseHeader (many parseRun)   symbol "!"   return rle @@ -122,8 +124,8 @@     runs' = (n - 1, rt) : runs      rows' = case rt of-      Dead -> add Pat.Dead rows-      Alive -> add Pat.Alive rows+      Dead -> add False rows+      Alive -> add True rows       Newline -> [] : rows      in updateRows runs' rows'@@ -139,7 +141,7 @@ The argument can be 'String', 'Text', or any other type with a 'Stream' instance. -This parser is fairly liberal. Whitespace is allowed everywhere except+Whitespace is allowed everywhere except in the middle of a number or rulestring, and there need not be a newline after the header. Also, text after the final @!@ character is ignored.@@ -150,6 +152,16 @@     Left _ -> Nothing     Right rle -> Just (toPattern rle) +{-|+Parse zero or more RLE files. The argument can be 'String', 'Text', or+any other type with a 'Stream' instance.+-}+parseMany :: (Stream s Identity Char) => s -> Maybe [(Maybe Rule, Pattern)]+parseMany str =+  case runParser (many parseRLE) () "" str of+    Left _ -> Nothing+    Right rles -> Just (map toPattern rles)+ updateRuns :: [[Pat.Cell]] -> [Run] -> [Run] updateRuns = let   add rt = \case@@ -159,8 +171,8 @@   in curry \case   ([], runs) -> reverse runs   ([] : rows, runs) -> updateRuns rows (add Newline runs)-  ((Pat.Dead : row) : rows, runs) -> updateRuns (row : rows) (add Dead runs)-  ((Pat.Alive : row) : rows, runs) -> updateRuns (row : rows) (add Alive runs)+  ((False : row) : rows, runs) -> updateRuns (row : rows) (add Dead runs)+  ((True : row) : rows, runs) -> updateRuns (row : rows) (add Alive runs)  fromShow :: (Show a, IsString s) => a -> s fromShow = String.fromString . show

@@ -0,0 +1,21 @@+{-# LANGUAGE BlockArguments #-}++module Data.CA.ListSpec (spec) where++import Test.Hspec (Spec, it, describe, shouldBe)++import Data.CA.List (withDimensions, combinations)+import TestPatterns++spec :: Spec+spec = do+  describe "Data.CA.List.withDimensions" do+    it "lists every pattern with the given dimensions" do+      withDimensions 0 0 `shouldBe` [empty]+      withDimensions 1 2 `shouldBe` oneByTwo+      withDimensions 2 2 `shouldBe` twoByTwo++  describe "Data.CA.List.combinations" do+    it "combines two patterns in multiple ways" do+      combinations (2, 3) (1, 2) singleton singleton+        `shouldBe` singletonCombos

@@ -0,0 +1,198 @@+{-# LANGUAGE BlockArguments, OverloadedStrings #-}++module Data.CA.PatternSpec (spec) where++import qualified Data.Vector as Vec++import Test.Hspec (Spec, it, describe, shouldBe)++import qualified Data.CA.Pattern as Pat+import TestPatterns++spec :: Spec+spec = do+  describe "Prelude.show" do+    it "shows a pattern's list structure" do+      show glider `shouldBe` ("fromList " +++        "[[False,True,False],[False,False,True],[True,True,True]]")++  describe "Data.CA.Pattern.lookup" do+    it "returns False for dead cells" do+      Pat.lookup 0 0 glider `shouldBe` False+      Pat.lookup 0 2 glider `shouldBe` False+    it "returns True for live cells" do+      Pat.lookup 2 0 glider `shouldBe` True+      Pat.lookup 2 2 glider `shouldBe` True+    it "returns False when out of bounds" do+      Pat.lookup 4 0 glider `shouldBe` False+      Pat.lookup 0 (-2) glider `shouldBe` False++  describe "Data.CA.Pattern.generate" do+    it "creates diagonal lines" do+      Pat.generate 3 4 (==) `shouldBe` diagonal+    it "creates horizontal stripes" do+      Pat.generate 5 3 (\r _ -> even r) `shouldBe` horizontal++  describe "Data.CA.Pattern.height" do+    it "returns a pattern's height" do+      Pat.height glider `shouldBe` 3+      Pat.height horizontal `shouldBe` 5+      Pat.height empty `shouldBe` 0++  describe "Data.CA.Pattern.width" do+    it "returns a pattern's width" do+      Pat.width glider `shouldBe` 3+      Pat.width horizontal `shouldBe` 3+      Pat.width empty `shouldBe` 0++  describe "Data.CA.Pattern.dimensions" do+    it "returns a pattern's height and width" do+      Pat.dimensions glider `shouldBe` (3, 3)+      Pat.dimensions horizontal `shouldBe` (5, 3)+      Pat.dimensions empty `shouldBe` (0, 0)++  describe "Data.CA.Pattern.valid" do+    it "returns True for rectangular patterns" do+      Pat.valid glider `shouldBe` True+      Pat.valid diagonal `shouldBe` True+      Pat.valid empty `shouldBe` True+    it "returns False for non-rectangular patterns" do+      Pat.valid fromRectList1 `shouldBe` False+      Pat.valid fromRectList2 `shouldBe` False++  describe "Data.CA.Pattern.fromRectList" do+    it "converts lists directly into patterns" do+      Pat.toList fromRectList1 `shouldBe` list1+      Pat.toList fromRectList2 `shouldBe` list2++  describe "Data.CA.Pattern.fromList" do+    it "pads non-rectangular patterns with dead cells" do+      Pat.toList fromList1 `shouldBe` paddedList1+      Pat.toList fromList2 `shouldBe` paddedList2++  describe "Data.CA.Pattern.toList" do+    it "converts patterns into lists" do+      Pat.toList glider `shouldBe`+        [ [ o, O, o ]+        , [ o, o, O ]+        , [ O, O, O ]+        ]++  describe "Data.CA.Pattern.fromRectVector" do+    it "converts vectors directly into patterns" do+      Pat.toVector fromRectVector1 `shouldBe` vector1+      Pat.toVector fromRectVector2 `shouldBe` vector2++  describe "Data.CA.Pattern.fromVector" do+    it "pads non-rectangular patterns with dead cells" do+      Pat.toVector fromVector1 `shouldBe` paddedVector1+      Pat.toVector fromVector2 `shouldBe` paddedVector2++  describe "Data.CA.Pattern.toVector" do+    it "converts patterns into vectors" do+      Pat.toVector glider `shouldBe` Vec.fromList+        [ Vec.fromList [ o, O, o ]+        , Vec.fromList [ o, o, O ]+        , Vec.fromList [ O, O, O ]+        ]++  describe "Data.CA.Pattern.toText" do+    it "converts patterns into text" do+      Pat.toText '.' 'O' glider `shouldBe` gliderStr1+      Pat.toText '_' '*' glider `shouldBe` gliderStr2+      Pat.toText 'v' 'v' empty `shouldBe` ""++  describe "Data.CA.Pattern.toString" do+    it "converts patterns into strings" do+      Pat.toString '.' 'O' glider `shouldBe` gliderStr1+      Pat.toString '_' '*' glider `shouldBe` gliderStr2+      Pat.toString 'v' 'v' empty `shouldBe` ""++  describe "Data.CA.Pattern.trimTop" do+    it "removes rows of dead cells from the top" do+      Pat.trimTop untrimmed `shouldBe` trimmedTop+    it "is idempotent" do+      Pat.trimTop trimmedTop `shouldBe` trimmedTop+    it "does nothing to the empty pattern" do+      Pat.trimTop empty `shouldBe` empty++  describe "Data.CA.Pattern.trimBottom" do+    it "removes rows of dead cells from the bottom" do+      Pat.trimBottom untrimmed `shouldBe` trimmedBottom+    it "is idempotent" do+      Pat.trimBottom trimmedBottom `shouldBe` trimmedBottom+    it "does nothing to the empty pattern" do+      Pat.trimBottom empty `shouldBe` empty++  describe "Data.CA.Pattern.trimLeft" do+    it "removes columns of dead cells from the left" do+      Pat.trimLeft untrimmed `shouldBe` trimmedLeft+    it "is idempotent" do+      Pat.trimLeft trimmedLeft `shouldBe` trimmedLeft+    it "does nothing to the empty pattern" do+      Pat.trimLeft empty `shouldBe` empty++  describe "Data.CA.Pattern.trimRight" do+    it "removes columns of dead cells from the right" do+      Pat.trimRight untrimmed `shouldBe` trimmedRight+    it "is idempotent" do+      Pat.trimRight trimmedRight `shouldBe` trimmedRight+    it "does nothing to the empty pattern" do+      Pat.trimRight empty `shouldBe` empty++  describe "Data.CA.Pattern.trim" do+    it "removes all layers of dead cells" do+      Pat.trim untrimmed `shouldBe` singleton+    it "is idempotent" do+      Pat.trim singleton `shouldBe` singleton+    it "does nothing to the empty pattern" do+      Pat.trim empty `shouldBe` empty++  describe "Data.CA.Pattern.setHeight" do+    it "adds rows of dead cells to the bottom" do+      Pat.setHeight 5 trimmedBottom `shouldBe` untrimmed+    it "removes rows from the bottom" do+      Pat.setHeight 3 untrimmed `shouldBe` trimmedBottom++  describe "Data.CA.Pattern.setWidth" do+    it "adds columns of dead cells to the right" do+      Pat.setWidth 5 trimmedRight `shouldBe` untrimmed+    it "removes columns from the right" do+      Pat.setWidth 3 untrimmed `shouldBe` trimmedRight++  describe "Data.CA.Pattern.setDimensions" do+    it "sets the height and width of a pattern" do+      Pat.setDimensions 4 5 glider `shouldBe` largeGlider+      Pat.setDimensions 2 4 glider `shouldBe` cutGlider+      Pat.setDimensions 2 3 empty `shouldBe` allDead++  describe "Data.CA.Pattern.reflectX" do+    it "reflects a pattern horizontally" do+      Pat.reflectX diagonal `shouldBe` reflectedX+    it "does nothing to the empty pattern" do+      Pat.reflectX empty `shouldBe` empty++  describe "Data.CA.Pattern.reflectY" do+    it "reflects a pattern vertically" do+      Pat.reflectY diagonal `shouldBe` reflectedY+    it "does nothing to the empty pattern" do+      Pat.reflectY empty `shouldBe` empty++  describe "Data.CA.Pattern.rotateL" do+    it "rotates a pattern counterclockwise" do+      Pat.rotateL diagonal `shouldBe` rotatedL+    it "does nothing to the empty pattern" do+      Pat.rotateL empty `shouldBe` empty++  describe "Data.CA.Pattern.rotateR" do+    it "rotates a pattern clockwise" do+      Pat.rotateR diagonal `shouldBe` rotatedR+    it "does nothing to the empty pattern" do+      Pat.rotateR empty `shouldBe` empty++  describe "Data.CA.Pattern.combine" do+    it "combines two patterns" do+      Pat.combine 3 2 glider glider `shouldBe` twoGliders1+      Pat.combine (-3) (-2) glider glider `shouldBe` twoGliders1+      Pat.combine 3 (-2) glider glider `shouldBe` twoGliders2+      Pat.combine (-3) 2 glider glider `shouldBe` twoGliders2

@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

@@ -0,0 +1,263 @@+{-# LANGUAGE OverloadedStrings, PatternSynonyms #-}++module TestPatterns where++import Data.String (IsString)++import qualified Data.Vector as Vec+import Data.Vector (Vector)++import qualified Data.CA.Pattern as Pat+import Data.CA.Pattern (Pattern, Cell)++o :: Cell+o = False++pattern O :: Cell+pattern O = True++empty :: Pattern+empty = Pat.fromList []++singleton :: Pattern+singleton = Pat.fromList [ [ O ] ]++allDead :: Pattern+allDead = Pat.fromList+  [ [ o, o, o ]+  , [ o, o, o ]+  ]++glider :: Pattern+glider = Pat.fromList+  [ [ o, O, o ]+  , [ o, o, O ]+  , [ O, O, O ]+  ]++largeGlider :: Pattern+largeGlider = Pat.fromList+  [ [ o, O, o, o, o ]+  , [ o, o, O, o, o ]+  , [ O, O, O, o, o ]+  , [ o, o, o, o, o ]+  ]++cutGlider :: Pattern+cutGlider = Pat.fromList+  [ [ o, O, o, o ]+  , [ o, o, O, o ]+  ]++twoGliders1 :: Pattern+twoGliders1 = Pat.fromList+  [ [ o, O, o, o, o ]+  , [ o, o, O, o, o ]+  , [ O, O, O, o, o ]+  , [ o, o, o, O, o ]+  , [ o, o, o, o, O ]+  , [ o, o, O, O, O ]+  ]++twoGliders2 :: Pattern+twoGliders2 = Pat.fromList+  [ [ o, o, o, O, o ]+  , [ o, o, o, o, O ]+  , [ o, o, O, O, O ]+  , [ o, O, o, o, o ]+  , [ o, o, O, o, o ]+  , [ O, O, O, o, o ]+  ]++gliderStr1, gliderStr2 :: (IsString s) => s+gliderStr1 = ".O.\n..O\nOOO\n"+gliderStr2 = "_*_\n__*\n***\n"++diagonal :: Pattern+diagonal = Pat.fromList+  [ [ O, o, o, o ]+  , [ o, O, o, o ]+  , [ o, o, O, o ]+  ]++reflectedX :: Pattern+reflectedX = Pat.fromList+  [ [ o, o, o, O ]+  , [ o, o, O, o ]+  , [ o, O, o, o ]+  ]++reflectedY :: Pattern+reflectedY = Pat.fromList+  [ [ o, o, O, o ]+  , [ o, O, o, o ]+  , [ O, o, o, o ]+  ]++rotatedL :: Pattern+rotatedL = Pat.fromList+  [ [ o, o, o ]+  , [ o, o, O ]+  , [ o, O, o ]+  , [ O, o, o ]+  ]++rotatedR :: Pattern+rotatedR = Pat.fromList+  [ [ o, o, O ]+  , [ o, O, o ]+  , [ O, o, o ]+  , [ o, o, o ]+  ]++horizontal :: Pattern+horizontal = Pat.fromList+  [ [ O, O, O ]+  , [ o, o, o ]+  , [ O, O, O ]+  , [ o, o, o ]+  , [ O, O, O ]+  ]++list1 :: [[Cell]]+list1 =+  [ [ o, O, o, O ]+  , [ O, o, o ]+  , [ o, O, o ]+  ]++list2 :: [[Cell]]+list2 =+  [ [ o, o, O ]+  , [ o, O, o ]+  , []+  ]++vector1, vector2 :: Vector (Vector Cell)+vector1 = Vec.fromList (map Vec.fromList list1)+vector2 = Vec.fromList (map Vec.fromList list2)++fromRectList1, fromRectList2 :: Pattern+fromRectList1 = Pat.fromRectList list1+fromRectList2 = Pat.fromRectList list2++fromList1, fromList2 :: Pattern+fromList1 = Pat.fromList list1+fromList2 = Pat.fromList list2++fromRectVector1, fromRectVector2 :: Pattern+fromRectVector1 = Pat.fromRectVector vector1+fromRectVector2 = Pat.fromRectVector vector2++fromVector1, fromVector2 :: Pattern+fromVector1 = Pat.fromVector vector1+fromVector2 = Pat.fromVector vector2++paddedList1 :: [[Cell]]+paddedList1 =+  [ [ o, O, o, O ]+  , [ O, o, o, o ]+  , [ o, O, o, o ]+  ]++paddedList2 :: [[Cell]]+paddedList2 =+  [ [ o, o, O ]+  , [ o, O, o ]+  , [ o, o, o ]+  ]++paddedVector1, paddedVector2 :: Vector (Vector Cell)+paddedVector1 = Vec.fromList (map Vec.fromList paddedList1)+paddedVector2 = Vec.fromList (map Vec.fromList paddedList2)++untrimmed :: Pattern+untrimmed = Pat.fromList+  [ [ o, o, o, o, o ]+  , [ o, o, o, o, o ]+  , [ o, o, O, o, o ]+  , [ o, o, o, o, o ]+  , [ o, o, o, o, o ]+  ]++trimmedTop :: Pattern+trimmedTop = Pat.fromList+  [ [ o, o, O, o, o ]+  , [ o, o, o, o, o ]+  , [ o, o, o, o, o ]+  ]++trimmedBottom :: Pattern+trimmedBottom = Pat.fromList+  [ [ o, o, o, o, o ]+  , [ o, o, o, o, o ]+  , [ o, o, O, o, o ]+  ]++trimmedLeft :: Pattern+trimmedLeft = Pat.fromList+  [ [ o, o, o ]+  , [ o, o, o ]+  , [ O, o, o ]+  , [ o, o, o ]+  , [ o, o, o ]+  ]++trimmedRight :: Pattern+trimmedRight = Pat.fromList+  [ [ o, o, o ]+  , [ o, o, o ]+  , [ o, o, O ]+  , [ o, o, o ]+  , [ o, o, o ]+  ]++oneByTwo :: [Pattern]+oneByTwo = map Pat.fromList+  [ [ [ o, o ] ]+  , [ [ o, O ] ]+  , [ [ O, o ] ]+  , [ [ O, O ] ]+  ]++twoByTwo :: [Pattern]+twoByTwo = map Pat.fromList+  [ [ [ o, o ], [ o, o ] ]+  , [ [ o, o ], [ o, O ] ]+  , [ [ o, o ], [ O, o ] ]+  , [ [ o, o ], [ O, O ] ]+  , [ [ o, O ], [ o, o ] ]+  , [ [ o, O ], [ o, O ] ]+  , [ [ o, O ], [ O, o ] ]+  , [ [ o, O ], [ O, O ] ]+  , [ [ O, o ], [ o, o ] ]+  , [ [ O, o ], [ o, O ] ]+  , [ [ O, o ], [ O, o ] ]+  , [ [ O, o ], [ O, O ] ]+  , [ [ O, O ], [ o, o ] ]+  , [ [ O, O ], [ o, O ] ]+  , [ [ O, O ], [ O, o ] ]+  , [ [ O, O ], [ O, O ] ]+  ]++singletonCombos :: [Pattern]+singletonCombos = map Pat.fromList+  [ [ [ O, o ]+    , [ o, o ]+    , [ o, O ]+    ]+  , [ [ O, o, o ]+    , [ o, o, o ]+    , [ o, o, O ]+    ]+  , [ [ O, o ]+    , [ o, o ]+    , [ o, o ]+    , [ o, O ]+    ]+  , [ [ O, o, o ]+    , [ o, o, o ]+    , [ o, o, o ]+    , [ o, o, O ]+    ]+  ]

@@ -0,0 +1,58 @@+{-# LANGUAGE BlockArguments #-}++module Text.RLESpec (spec) where++import Test.Hspec (Spec, it, describe, shouldBe)++import qualified Text.RLE as RLE+import TestPatterns++spec :: Spec+spec = do+  describe "Text.RLE.parse" do+    it "parses the empty pattern" do+      RLE.parse "x=0,y=0!" `shouldBe` Just (Nothing, empty)+    it "sets the dimensions of a pattern" do+      RLE.parse "x=3,y=2!" `shouldBe` Just (Nothing, allDead)+      RLE.parse "x=5,y=4 bo$2bo$3o!" `shouldBe` Just (Nothing, largeGlider)+      RLE.parse "x=4,y=2 bo$2bo$3o!" `shouldBe` Just (Nothing, cutGlider)+    it "parses gliders" do+      RLE.parse "x=3,y=3 bo$2bo$3o!" `shouldBe` Just (Nothing, glider)+      RLE.parse "x=3,y=3 bo$bbo$ooo!" `shouldBe` Just (Nothing, glider)+      RLE.parse "x=3,y=3 bob$2bo$3o$$!" `shouldBe` Just (Nothing, glider)+    it "tolerates whitespace" do+      RLE.parse " x = 0 \n , y = 0 \n ! " `shouldBe` Just (Nothing, empty)+      RLE.parse "x=3,y=3 bo b$2\nbo$ 3o\n!" `shouldBe` Just (Nothing, glider)+    it "ignores characters after the !" do+      RLE.parse "x=0,y=0!hello, world!" `shouldBe` Just (Nothing, empty)+    it "parses comments" do+      RLE.parse " #a\n# bcd \nx=0,y=0!" `shouldBe` Just (Nothing, empty)+    it "parses rulestrings" do+      RLE.parse "x=0,y=0,rule=b2ak3-jnqr4ce/s23 !"+        `shouldBe` Just (Just "b2ak3-jnqr4ce/s23", empty)+      RLE.parse "x=3,y=3,rule=b3/s23 bo$2bo$3o!"+        `shouldBe` Just (Just "b3/s23", glider)++  describe "Text.RLE.parseMany" do+    it "parses no patterns" do+      RLE.parseMany "" `shouldBe` Just []+    it "parses one pattern" do+      RLE.parseMany "x=3,y=3 bo$2bo$3o!" `shouldBe` Just [(Nothing, glider)]+    it "parses multiple patterns and ignores characters after the last !" do+      RLE.parseMany ("#empty \nx=0,y=0!" +++        "#glider \nx=3,y=3,rule=b3/s23 bo$2bo$3o!" +++        "#diagonal \nx=4,y=3 o$bo$2bo! ignore")+        `shouldBe` Just+          [ (Nothing, empty)+          , (Just "b3/s23", glider)+          , (Nothing, diagonal)+          ]++  describe "Text.RLE.make" do+    it "converts patterns into RLEs" do+      RLE.make Nothing empty `shouldBe` "x = 0, y = 0\n!\n"+      RLE.make Nothing glider `shouldBe` "x = 3, y = 3\nbob$2bo$3o$!\n"+      RLE.make Nothing diagonal `shouldBe` "x = 4, y = 3\no3b$bo2b$2bob$!\n"+    it "allows rulestrings" do+      RLE.make (Just "b3/s23") glider+        `shouldBe` "x = 3, y = 3, rule = b3/s23\nbob$2bo$3o$!\n"