hs2048 (empty) → 0.1.0

raw patch · 33 files changed

+1678/−0 lines, 33 filesdep +Globdep +HUnitdep +QuickChecksetup-changed

Dependencies added: Glob, HUnit, QuickCheck, base, criterion, doctest, hastache, hlint, hs2048, hscolour, hspec, process, random, regex-compat, statistics

Files

CHANGELOG.md +7/−0
CONTRIBUTING.md +7/−0
LICENSE.txt +22/−0
README.md +38/−0
Setup.hs +2/−0
benchmark/Bench.hs +29/−0
executable/Main.hs +7/−0
hs2048.cabal +207/−0
library/Hs2048.hs +17/−0
library/Hs2048/Board.hs +160/−0
library/Hs2048/Direction.hs +38/−0
library/Hs2048/Game.hs +118/−0
library/Hs2048/Main.hs +72/−0
library/Hs2048/Point.hs +30/−0
library/Hs2048/Renderer.hs +93/−0
library/Hs2048/Settings.hs +43/−0
library/Hs2048/Tile.hs +79/−0
library/Hs2048/Vector.hs +113/−0
test-suite/DocTest.hs +7/−0
test-suite/HLint.hs +17/−0
test-suite/HPC.hs +31/−0
test-suite/Haddock.hs +30/−0
test-suite/Hs2048/BoardSpec.hs +146/−0
test-suite/Hs2048/DirectionSpec.hs +46/−0
test-suite/Hs2048/GameSpec.hs +112/−0
test-suite/Hs2048/MainSpec.hs +32/−0
test-suite/Hs2048/PointSpec.hs +16/−0
test-suite/Hs2048/RendererSpec.hs +31/−0
test-suite/Hs2048/SettingsSpec.hs +22/−0
test-suite/Hs2048/TileSpec.hs +39/−0
test-suite/Hs2048/VectorSpec.hs +59/−0
test-suite/Hs2048Spec.hs +7/−0
test-suite/Spec.hs +1/−0

+ CHANGELOG.md view

@@ -0,0 +1,7 @@+# Changelog++## Master++## v0.1.0++-   Initial release.

+ CONTRIBUTING.md view

@@ -0,0 +1,7 @@+# Contributing
+
+1. Fork it.
+2. Create your feature branch (`git checkout -b my-feature`).
+3. Commit your changes (`git commit -a -m 'Add feature'`).
+4. Push to the branch (`git push origin my-feature`).
+5. Create new pull request.

+ LICENSE.txt view

@@ -0,0 +1,22 @@+The MIT License (MIT)
+
+Copyright (c) 2014 Taylor Fausak <taylor@fausak.me>
+
+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.
+

+ README.md view

@@ -0,0 +1,38 @@+# [hs2048][1]++[![Build Status][2]][3]++A [2048][4] clone in Haskell.++![Screenshot](http://i.imgur.com/utw0O1h.png)++## Setup++``` sh+$ vagrant up+$ vagrant ssh+```++``` sh+$ cd /vagrant+$ make+$ make run+```++## Others++- <https://github.com/DavidMihola/2048>+- <https://github.com/Javran/h2048>+- <https://github.com/YawarRaza7349/2048Game.hs>+- <https://github.com/badamson/2048.hs>+- <https://github.com/chrismwendt/2048>+- <https://github.com/egonSchiele/ones>+- <https://github.com/godel9/2048-hs>+- <https://github.com/jgallag88/2048>+- <https://github.com/mitchellwrosen/hs2048-free>+- <https://github.com/uncleverone/haskell2048>++[1]: https://github.com/tfausak/hs2048+[2]: https://travis-ci.org/tfausak/hs2048.svg?branch=master+[3]: https://travis-ci.org/tfausak/hs2048+[4]: https://github.com/gabrielecirulli/2048

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ benchmark/Bench.hs view

@@ -0,0 +1,29 @@+module Main (main) where++import           Criterion.Main        (bgroup, defaultMain)+import qualified Hs2048.BoardBench+import qualified Hs2048.DirectionBench+import qualified Hs2048.GameBench+import qualified Hs2048.MainBench+import qualified Hs2048.PointBench+import qualified Hs2048.RendererBench+import qualified Hs2048.SettingsBench+import qualified Hs2048.TileBench+import qualified Hs2048.VectorBench+import qualified Hs2048Bench+-- HASKELETON: import qualified New.ModuleBench++main :: IO ()+main = defaultMain+    [ bgroup "Hs2048" Hs2048Bench.benchmarks+    , bgroup "Hs2048.Board" Hs2048.BoardBench.benchmarks+    , bgroup "Hs2048.Direction" Hs2048.DirectionBench.benchmarks+    , bgroup "Hs2048.Game" Hs2048.GameBench.benchmarks+    , bgroup "Hs2048.Main" Hs2048.MainBench.benchmarks+    , bgroup "Hs2048.Point" Hs2048.PointBench.benchmarks+    , bgroup "Hs2048.Renderer" Hs2048.RendererBench.benchmarks+    , bgroup "Hs2048.Settings" Hs2048.SettingsBench.benchmarks+    , bgroup "Hs2048.Tile" Hs2048.TileBench.benchmarks+    , bgroup "Hs2048.Vector" Hs2048.VectorBench.benchmarks+    -- HASKELETON: , bgroup "New.Module" New.ModuleBench.benchmarks+    ]

+ executable/Main.hs view

@@ -0,0 +1,7 @@+module Main (main) where++import           Hs2048        (new, play)+import           System.Random (getStdGen)++main :: IO ()+main = getStdGen >>= play . new

+ hs2048.cabal view

@@ -0,0 +1,207 @@+author:+    Taylor Fausak+bug-reports:+    https://github.com/tfausak/hs2048/issues+build-type:+    Simple+cabal-version:+    >= 1.18+category:+    Game+copyright:+    2014 Taylor Fausak <taylor@fausak.me>+description:+    A <https://github.com/gabrielecirulli/2048 2048> clone in Haskell.+    .+    This implements the game logic as well as a console interface for playing+    it.+extra-source-files:+    CHANGELOG.md+    CONTRIBUTING.md+    README.md+homepage:+    https://github.com/tfausak/hs2048+license-file:+    LICENSE.txt+license:+    MIT+maintainer:+    taylor@fausak.me+name:+    hs2048+synopsis:+    A 2048 clone in Haskell.+tested-with:+    GHC == 7.6.3+version:+    0.1.0++source-repository head+    location:+        git://github.com/tfausak/threase.git+    type:+        git++flag documentation+    default:+        False++library+    build-depends:+        base < 5+      , random == 1.*+    default-language:+        Haskell2010+    exposed-modules:+        Hs2048+        Hs2048.Board+        Hs2048.Direction+        Hs2048.Game+        Hs2048.Main+        Hs2048.Point+        Hs2048.Renderer+        Hs2048.Settings+        Hs2048.Tile+        Hs2048.Vector+        -- HASKELETON: New.Module+    ghc-prof-options:+        -auto-all+        -prof+    hs-source-dirs:+        library++    if flag(documentation)+        build-depends:+            hscolour == 1.*++executable hs2048+    build-depends:+        base < 5+      , hs2048+      , random == 1.*+    default-language:+        Haskell2010+    ghc-prof-options:+        -auto-all+        -prof+    hs-source-dirs:+        executable+    main-is:+        Main.hs++test-suite hspec+    build-depends:+        base < 5+      , hs2048+      , hspec == 1.*+          , HUnit+          , QuickCheck+      , random == 1.*+    default-language:+        Haskell2010+    ghc-options:+        -fhpc+        -Wall+        -Werror+    hs-source-dirs:+        library+        test-suite+    main-is:+        Spec.hs+    other-modules:+        Hs2048+        Hs2048.Board+        Hs2048.Direction+        Hs2048.Game+        Hs2048.Main+        Hs2048.Point+        Hs2048.Renderer+        Hs2048.Settings+        Hs2048.Tile+        Hs2048.Vector+        -- HASKELETON: New.Module+        Hs2048Spec+        Hs2048.BoardSpec+        Hs2048.DirectionSpec+        Hs2048.GameSpec+        Hs2048.MainSpec+        Hs2048.PointSpec+        Hs2048.RendererSpec+        Hs2048.SettingsSpec+        Hs2048.TileSpec+        Hs2048.VectorSpec+        -- HASKELETON: New.ModuleSpec+    type:+        exitcode-stdio-1.0++test-suite doctest+    build-depends:+        base < 5+      , Glob == 0.*+      , doctest == 0.*+    default-language:+        Haskell2010+    hs-source-dirs:+        test-suite+    main-is:+        DocTest.hs+    type:+        exitcode-stdio-1.0++test-suite hpc+    build-depends:+        base < 5+      , process == 1.*+      , regex-compat == 0.*+    default-language:+        Haskell2010+    hs-source-dirs:+        test-suite+    main-is:+        HPC.hs+    type:+        exitcode-stdio-1.0++test-suite haddock+    build-depends:+        base < 5+      , process == 1.*+      , regex-compat == 0.*+    default-language:+        Haskell2010+    hs-source-dirs:+        test-suite+    main-is:+        Haddock.hs+    type:+        exitcode-stdio-1.0++test-suite hlint+    build-depends:+        base+      , hlint == 1.*+    default-language:+        Haskell2010+    hs-source-dirs:+        test-suite+    main-is:+        HLint.hs+    type:+        exitcode-stdio-1.0++benchmark benchmarks+    build-depends:+        base < 5+      , hs2048+      , criterion == 0.6.*+          , hastache < 0.6+          , statistics < 0.11+      , random == 1.*+    default-language:+        Haskell2010+    hs-source-dirs:+        benchmark+    main-is:+        Bench.hs+    type:+        exitcode-stdio-1.0

+ library/Hs2048.hs view

@@ -0,0 +1,17 @@+{- |+    Top-level module. Re-exports things from all other modules.+-}+module Hs2048 (module Hs2048) where++import           Hs2048.Board     as Hs2048+import           Hs2048.Direction as Hs2048 hiding (render)+import           Hs2048.Game      as Hs2048+import           Hs2048.Main      as Hs2048+import           Hs2048.Point     as Hs2048+import           Hs2048.Renderer  as Hs2048+import           Hs2048.Settings  as Hs2048+import           Hs2048.Tile      as Hs2048 hiding (empty, parse, render,+                                             score)+import           Hs2048.Vector    as Hs2048 hiding (canShift, empty, parse,+                                             render, score, set, shift)+-- HASKELETON: import New.Module as Hs2048

+ library/Hs2048/Board.hs view

@@ -0,0 +1,160 @@+-- | Types and functions for manipulating boards.+module Hs2048.Board+    ( Board+    , canMove+    , canShift+    , empty+    , emptyPoints+    , move+    , parse+    , render+    , rotate+    , rotateFrom+    , rotateTo+    , score+    , set+    , shift+    ) where++import           Data.List        (transpose)+import qualified Hs2048.Direction as D+import qualified Hs2048.Point     as P+import qualified Hs2048.Tile      as T+import qualified Hs2048.Vector    as V++{- |+    Represents the game board. By convention, it is row-major.+-}+type Board = [V.Vector]++{- |+    Determines if the board can be moved in the given direction. See 'move'.++    >>> canMove [[Nothing, Just 2]] D.West+    True+-}+canMove :: Board -> D.Direction -> Bool+canMove b d = move b d /= b++{- |+    Determines if the board can be shifted. See 'shift'.++    >>> canShift [[Nothing, Just 2]]+    True+-}+canShift :: Board -> Bool+canShift b = shift b /= b++{- |+    Returns an empty board of the given size.++    >>> empty 2 1+    [[Nothing,Nothing]]+-}+empty :: Int -- ^ Width+    -> Int -- ^ Height+    -> Board+empty = flip replicate . V.empty++{- |+    Returns the points that don't contain tiles.++    >>> emptyPoints [[Nothing, Just 2]]+    [(0,0)]+-}+emptyPoints :: Board -> [P.Point]+emptyPoints b = zip [0 ..] (fmap V.emptyIndexes b) >>= go+  where+    go (x, ys) = fmap ((,) x) ys++{- |+    Moves the board in the given direction.++    >>> move [[Nothing, Just 2]] D.West+    [[Just 2,Nothing]]+-}+move :: Board -> D.Direction -> Board+move b d = rotateFrom (shift (rotateTo b d)) d++{- |+    Parses a string as a board. This is the inverse of 'render'.++    >>> parse "- 2\n4 -\n"+    [[Nothing,Just 2],[Just 4,Nothing]]+-}+parse :: String -> Board+parse = fmap V.parse . lines++{- |+    Renders a board as a string. This is the inverse of 'parse'.++    >>> render [[Nothing, Just 2], [Just 4, Nothing]]+    "- 2\n4 -\n"+-}+render :: Board -> String+render = unlines . fmap V.render++{- |+    Rotate the board 90 degrees clockwise.++    >>> rotate [[Nothing, Just 2], [Just 4, Nothing]]+    [[Just 4,Nothing],[Nothing,Just 2]]+-}+rotate :: Board -> Board+rotate = fmap reverse . transpose++{- |+    Rotates the board so that 'Hs2048.Direction.West' is at the left, assuming+    the given direction is currently at the left. This is the inverse of+    'rotateTo'.++    >>> rotateFrom [[Just 4, Nothing], [Nothing, Just 2]] D.South+    [[Nothing,Just 2],[Just 4,Nothing]]+-}+rotateFrom :: Board -> D.Direction -> Board+rotateFrom b d = head (drop n gs)+  where+    n = 1 + fromEnum (maxBound :: D.Direction) - fromEnum d+    gs = iterate rotate b++{- |+    Rotates the board so that the given direction is at the left. This is the+    inverse of 'rotateFrom'++    >>> rotateTo [[Nothing, Just 2], [Just 4, Nothing]] D.South+    [[Just 4,Nothing],[Nothing,Just 2]]+-}+rotateTo :: Board -> D.Direction -> Board+rotateTo b d = head (drop n gs)+  where+    n = fromEnum d+    gs = iterate rotate b++{- |+    Calculates the score of a board.++    >>> score [[Nothing, Just 2], [Just 4, Just 8]]+    20+-}+score :: Board -> Int+score = sum . fmap V.score++{- |+    Sets a tile at the given point in the board.++    >>> set [[Nothing, Just 2], [Just 4, Nothing]] (Just 8) (1, 1)+    [[Nothing,Just 2],[Just 4,Just 8]]+-}+set :: Board -> T.Tile -> P.Point -> Board+set b t p = zipWith go [0 ..] b+  where+    go i v = if i == P.x p then V.set v t (P.y p) else v++{- |+    Shifts a board toward the head. See 'Vector.shift'.++    >>> shift [[Nothing, Just 2], [Just 4, Nothing]]+    [[Just 2,Nothing],[Just 4,Nothing]]+-}+shift :: Board -> Board+shift = fmap V.shift

+ library/Hs2048/Direction.hs view

@@ -0,0 +1,38 @@+-- | Types and functions for manipulating directions.+module Hs2048.Direction+    ( Direction (..)+    , directions+    , render+    ) where++{- |+    Represents a direction that the game board can be moved in. The cardinal+    directions are used to avoid collisions with 'Left' and 'Right'.+-}+data Direction+    = West+    | South+    | East+    | North+    deriving (Bounded, Enum, Eq, Show)++{- |+    Returns all of the directions.++    >>> directions+    [West,South,East,North]+-}+directions :: [Direction]+directions = [minBound ..]++{- |+    Renders a direction as a string.++    >>> render West+    "\8592"+-}+render :: Direction -> String+render West = "\x2190"+render South = "\x2193"+render East = "\x2192"+render North = "\x2191"

+ library/Hs2048/Game.hs view

@@ -0,0 +1,118 @@+-- | Functions for playing the game.+module Hs2048.Game+    ( addRandomTile+    , addRandomTiles+    , hasWon+    , isOver+    , new+    , randomEmptyIndex+    , randomEmptyPoint+    , randomTile+    ) where++import           Data.Maybe       (fromJust)+import qualified Hs2048.Board     as B+import qualified Hs2048.Direction as D+import qualified Hs2048.Point     as P+import qualified Hs2048.Settings  as S+import qualified Hs2048.Tile      as T+import qualified Hs2048.Vector    as V+import qualified System.Random    as R++{- |+    Adds a random tile to the board.++    >>> addRandomTile [[Nothing], [Nothing]] (R.mkStdGen 0)+    ([[Nothing],[Just 2]],1346387765 2103410263)+-}+addRandomTile :: R.RandomGen r => B.Board -> r -> (B.Board, r)+addRandomTile b r = case p of+    Nothing -> (b, r)+    _ -> (b', r'')+  where+    b' = B.set b t (fromJust p)+    (p, r') = randomEmptyPoint b r+    (t, r'') = randomTile r'++{- |+    Adds some random tiles to the board.++    >>> addRandomTiles 2 [[Nothing], [Nothing]] (R.mkStdGen 0)+    ([[Just 2],[Just 2]],2127568003 1780294415)+-}+addRandomTiles :: R.RandomGen r => Int -> B.Board -> r -> (B.Board, r)+addRandomTiles 0 b r = (b, r)+addRandomTiles n b r = addRandomTiles (n - 1) b' r'+  where+    (b', r') = addRandomTile b r++{- |+    Determines if the game has been won. See 'Hs2048.Settings.maxTile'.++    >>> hasWon [[Just 2048]]+    True+-}+hasWon :: B.Board -> Bool+hasWon = any (any (maybe False (>= S.maxTile)))++{- |+    Determines if the game is over. The game is over if there are no available+    moves and no empty points.++    >>> isOver [[Just 2]]+    True+-}+isOver :: B.Board -> Bool+isOver b = cantMove && haveNoEmptyPoints+  where+    cantMove = not (any (B.canMove b) D.directions)+    haveNoEmptyPoints = null (B.emptyPoints b)++{- |+    Creates a new game by making an empty board and adding some random tiles to+    it. See 'Hs2048.Settings.width', 'Hs2048.Settings.height', and+    'Hs2048.Settings.tiles'.++    >>> new (R.mkStdGen 0)+    ([[Just 2,Nothing,Nothing,Nothing],[Nothing,Nothing,Nothing,Nothing],[Nothing,Nothing,Nothing,Nothing],[Nothing,Just 2,Nothing,Nothing]],2127568003 1780294415)+-}+new :: R.RandomGen r => r -> (B.Board, r)+new = addRandomTiles S.tiles (B.empty S.width S.height)++{- |+    Selects an empty index at random from a vector.++    >>> randomEmptyIndex [Nothing, Nothing] (R.mkStdGen 0)+    (Just 1,40014 40692)+-}+randomEmptyIndex :: R.RandomGen r => V.Vector -> r -> (Maybe Int, r)+randomEmptyIndex v r = if null is then (Nothing, r) else (Just i, r')+  where+    i = is !! x+    (x, r') = R.randomR (0, length is - 1) r+    is = V.emptyIndexes v++{- |+    Selects an empty point at random from a board.++    >>> randomEmptyPoint [[Nothing],[Nothing]] (R.mkStdGen 0)+    (Just (1,0),40014 40692)+-}+randomEmptyPoint :: R.RandomGen r => B.Board -> r -> (Maybe P.Point, r)+randomEmptyPoint b r = if null ps then (Nothing, r) else (Just p, r')+  where+    p = ps !! x+    (x, r') = R.randomR (0, length ps - 1) r+    ps = B.emptyPoints b++{- |+    Creates a random tile.++    >>> randomTile (R.mkStdGen 0)+    (Just 2,1601120196 1655838864)+-}+randomTile :: R.RandomGen r => r -> (T.Tile, r)+randomTile r = (Just n, r')+  where+    n = if (x :: Float) < 0.9 then 2 else 4+    (x, r') = R.random r

+ library/Hs2048/Main.hs view

@@ -0,0 +1,72 @@+-- | Main entry point for the console interface to the game.+module Hs2048.Main+    ( direction+    , getChars+    , getMove+    , play+    ) where++import qualified Hs2048.Board     as B+import qualified Hs2048.Direction as D+import qualified Hs2048.Game      as G+import           Hs2048.Renderer  (renderGame)+import           System.IO        (BufferMode (NoBuffering), hSetBuffering,+                                   hSetEcho, stdin)+import qualified System.Random    as R++{- |+    Converts a string into a direction.++    >>> direction "\ESC[D"+    Just West+    >>> direction "<"+    Nothing+-}+direction :: String -> Maybe D.Direction+direction "\ESC[D" = Just D.West+direction "\ESC[B" = Just D.South+direction "\ESC[C" = Just D.East+direction "\ESC[A" = Just D.North+direction _ = Nothing++{- |+    Gets up to three characters from standard input. If the input corresponds+    to an arrow key, it will be returned. Otherwise 'Nothing' will be returned.+    Will only consume enough input to determine if the input is an arrow key or+    not.+-}+getChars :: IO (Maybe String)+getChars = do+    a <- getChar+    if a /= '\ESC' then return Nothing else do+        b <- getChar+        if b /= '[' then return Nothing else do+            c <- getChar+            return $ if c `elem` "ABCD"+                then Just [a, b, c]+                else Nothing++{- |+    Reads from standard input and converts it into a direction. See 'getChars'.+-}+getMove :: IO (Maybe D.Direction)+getMove = fmap (maybe Nothing direction) getChars++{- |+    Plays the game.+-}+play :: R.RandomGen r => (B.Board, r) -> IO ()+play (b, r) = do+    hSetBuffering stdin NoBuffering+    hSetEcho stdin False++    putStr (renderGame b)++    if G.hasWon b then putStrLn "You won!" else do+        if G.isOver b then putStrLn "You lost." else do+            m <- getMove+            case m of+                Nothing -> putStrLn "Unknown move." >> play (b, r)+                Just d -> if B.canMove b d+                    then putStrLn (D.render d) >> play (G.addRandomTile (B.move b d) r)+                    else putStrLn "Invalid move." >> play (b, r)

+ library/Hs2048/Point.hs view

@@ -0,0 +1,30 @@+-- | Types and functions for manipulating points.+module Hs2048.Point+    ( Point+    , x+    , y+    ) where++{- |+    Represents a point on a game board. The top-left corner is (0, 0) with x+    increasing left-to-right and y increasing top-to-bottom.+-}+type Point = (Int, Int)++{- |+    Returns the x part of a point.++    >>> x (1, 2)+    1+-}+x :: Point -> Int+x = fst++{- |+    Returns the y part of a point.++    >>> y (1, 2)+    2+-}+y :: Point -> Int+y = snd

+ library/Hs2048/Renderer.hs view

@@ -0,0 +1,93 @@+-- | Functions for pretty-printing games to the console.+module Hs2048.Renderer+    ( center+    , color+    , renderBoard+    , renderGame+    , renderTile+    ) where++import           Data.Monoid  ((<>))+import qualified Hs2048.Board as B+import qualified Hs2048.Tile  as T++{- |+    Centers a string in the given number of characters, using spaces for+    padding.++    >>> center 3 "x"+    " x "+    >>> center 2 "x"+    " x"+-}+center :: Int -> String -> String+center w s = prefix <> s <> suffix+  where+    prefix = replicate (ceiling n) ' '+    suffix = replicate (floor n) ' '+    n = fromIntegral (w - length s) / (2 :: Float)++{- |+    Calculates the color code for a tile. See+    <http://en.wikipedia.org/wiki/ANSI_escape_code#Colors>.++    >>> color Nothing+    30+    >>> color (Just 2)+    31+    >>> color (Just 2048)+    45+-}+color :: T.Tile -> Int+color t = 30 + x+  where+    x = if r > 6 then r + 4 else r+    r = T.rank t++{- |+    Renders a board with colorized, centered tiles. See 'renderTile' and+    'center'.++    >>> renderBoard [[Nothing, Just 2]]+    "\ESC[30m-\ESC[0m \ESC[31m2\ESC[0m\n"+    >>> renderBoard [[Nothing, Just 16]]+    " \ESC[30m-\ESC[0m \ESC[34m16\ESC[0m\n"+-}+renderBoard :: B.Board -> String+renderBoard b = unlines (fmap unwords vs')+  where+    vs' = fmap (fmap (center l)) vs+    vs = fmap (fmap renderTile) b+    l = maximum ls+    ls = vs >>= fmap length++{- |+    Renders a board along with its score. See 'renderBoard'.++    >>> renderGame [[Nothing, Just 2]]+    "Score: 0\n\ESC[30m-\ESC[0m \ESC[31m2\ESC[0m\n"+-}+renderGame :: B.Board -> String+renderGame b = concat+    [ "Score: "+    , show (B.score b)+    , "\n"+    , renderBoard b+    ]++{- |+    Renders a colorized tile. See 'color'.++    >>> renderTile Nothing+    "\ESC[30m-\ESC[0m"+    >>> renderTile (Just 2)+    "\ESC[31m2\ESC[0m"+-}+renderTile :: T.Tile -> String+renderTile t = concat+    [ "\ESC["+    , show (color t)+    , "m"+    , T.render t+    , "\ESC[0m"+    ]

+ library/Hs2048/Settings.hs view

@@ -0,0 +1,43 @@+-- | Game settings.+module Hs2048.Settings+    ( height+    , maxTile+    , tiles+    , width+    ) where++{- |+    Returns the height of the game board.++    >>> height+    4+-}+height :: Int+height = 4++{- |+    Returns the maximum tile value.++    >>> maxTile+    2048+-}+maxTile :: Int+maxTile = 2048++{- |+    Returns the number of starting tiles.++    >>> tiles+    2+-}+tiles :: Int+tiles = 2++{- |+    Returns the width of the game board.++    >>> width+    4+-}+width :: Int+width = 4

+ library/Hs2048/Tile.hs view

@@ -0,0 +1,79 @@+-- | Types and functions for manipulating tiles.+module Hs2048.Tile+    ( Tile+    , empty+    , parse+    , rank+    , render+    , score+    ) where++{- |+    Represents a tile on the game board. Can be empty (@Nothing@) or can have a+    value (@Just n@). By convention, a tile's value is always a power of 2.+-}+type Tile = Maybe Int++{- |+    Returns the empty tile.++    >>> empty+    Nothing+-}+empty :: Tile+empty = Nothing++{- |+    Parses a string as a tile. This is the inverse of 'render'.++    >>> parse "-"+    Nothing+    >>> parse "2"+    Just 2+-}+parse :: String -> Tile+parse "-" = Nothing+parse s = Just (read s)++{- |+    Calculates the rank of a tile.++    >>> rank Nothing+    0+    >>> rank (Just 2)+    1+    >>> rank (Just 2048)+    11+-}+rank :: Tile -> Int+rank Nothing = 0+rank (Just n) = floor (logBase b n')+  where+    b = 2 :: Double+    n' = fromIntegral n++{- |+    Renders a tile as a string. This is the inverse of 'parse'.++    >>> render Nothing+    "-"+    >>> render (Just 2)+    "2"+-}+render :: Tile -> String+render Nothing = "-"+render (Just n) = show n++{- |+    Calculates the score of a tile.++    >>> score Nothing+    0+    >>> score (Just 2)+    0+    >>> score (Just 2048)+    20480+-}+score :: Tile -> Int+score Nothing = 0+score t@(Just n) = n * (rank t - 1)

+ library/Hs2048/Vector.hs view

@@ -0,0 +1,113 @@+-- | Types and functions for manipulating vectors.+module Hs2048.Vector+    ( Vector+    , canShift+    , empty+    , emptyIndexes+    , parse+    , render+    , score+    , set+    , shift+    ) where++import           Data.List   (group)+import           Data.Maybe  (isJust, isNothing)+import           Data.Monoid ((<>))+import qualified Hs2048.Tile as T++{- |+    Represents a row or column on the game board. By convention, a vector has+    4 tiles.+-}+type Vector = [T.Tile]++{- |+    Determines if the vector can be shifted.++    >>> canShift [Nothing, Just 2, Nothing, Nothing]+    True+-}+canShift :: Vector -> Bool+canShift v = shift v /= v++{- |+    Returns an empty vector of the given size.++    >>> empty 4+    [Nothing,Nothing,Nothing,Nothing]+-}+empty :: Int -> Vector+empty = flip replicate T.empty++{- |+    Returns the indexes that don't contain tiles.++    >>> emptyIndexes [Nothing, Just 2, Nothing, Nothing]+    [0,2,3]+-}+emptyIndexes :: Vector -> [Int]+emptyIndexes = fmap fst . filter (isNothing . snd) . zip [0 ..]++{- |+    Parses a string as a vector. This is the inverse of 'render'.++    >>> parse "- 2 - -"+    [Nothing,Just 2,Nothing,Nothing]+-}+parse :: String -> Vector+parse = fmap T.parse . words++{- |+    Renders a vector as a string. This is the inverse of 'parse'.++    >>> render [Nothing, Just 2, Nothing, Nothing]+    "- 2 - -"+-}+render :: Vector -> String+render = unwords . fmap T.render++{- |+    Calculates the score of a vector.++    >>> score [Nothing, Just 2, Just 4, Just 8]+    20+-}+score :: Vector -> Int+score = sum . fmap T.score++{- |+    Sets a tile at the given index in the vector.++    >>> set [Nothing, Nothing, Nothing, Nothing] (Just 2) 1+    [Nothing,Just 2,Nothing,Nothing]+-}+set :: Vector -> T.Tile -> Int -> Vector+set v t i = zipWith go [0 ..] v+  where+    go i' t' = if i' == i then t else t'++{- |+    Shifts a vector toward the head. The output vector will be the same size as+    the input vector, padded with @Nothing@.++    >>> shift [Nothing, Just 2, Nothing, Nothing]+    [Just 2,Nothing,Nothing,Nothing]++    Like tiles will be combined.++    >>> shift [Just 2, Nothing, Just 2, Just 2]+    [Just 4,Just 2,Nothing,Nothing]++    Any number of tiles can be combined in one shift.++    >>> shift [Just 2, Just 2, Just 4, Just 4]+    [Just 4,Just 8,Nothing,Nothing]+-}+shift :: Vector -> Vector+shift v = take n (v' <> empty n)+  where+    n = length v+    v' = group (filter isJust v) >>= go+    go (Just a : Just b : ts) = Just (a + b) : go ts+    go ts = ts

+ test-suite/DocTest.hs view

@@ -0,0 +1,7 @@+module Main (main) where++import           System.FilePath.Glob (glob)+import           Test.DocTest         (doctest)++main :: IO ()+main = glob "library/**/*.hs" >>= doctest

+ test-suite/HLint.hs view

@@ -0,0 +1,17 @@+module Main (main) where++import           Language.Haskell.HLint (hlint)+import           System.Exit            (exitFailure, exitSuccess)++arguments :: [String]+arguments =+    [ "benchmark"+    , "executable"+    , "library"+    , "test-suite"+    ]++main :: IO ()+main = do+    hints <- hlint arguments+    if null hints then exitSuccess else exitFailure

+ test-suite/HPC.hs view

@@ -0,0 +1,31 @@+module Main (main) where++import           Data.List      (genericLength)+import           Data.Maybe     (catMaybes)+import           System.Exit    (exitFailure, exitSuccess)+import           System.Process (readProcess)+import           Text.Regex     (matchRegex, mkRegex)++arguments :: [String]+arguments =+    [ "report"+    , "dist/hpc/tix/hspec/hspec.tix"+    ]++average :: (Fractional a, Real b) => [b] -> a+average xs = realToFrac (sum xs) / genericLength xs++expected :: Fractional a => a+expected = 80++main :: IO ()+main = do+    output <- readProcess "hpc" arguments ""+    if average (match output) >= expected+        then exitSuccess+        else putStr output >> exitFailure++match :: String -> [Int]+match = fmap read . concat . catMaybes . fmap (matchRegex pattern) . lines+  where+    pattern = mkRegex "^ *([0-9]*)% "

+ test-suite/Haddock.hs view

@@ -0,0 +1,30 @@+module Main (main) where++import           Data.List      (genericLength)+import           Data.Maybe     (catMaybes)+import           System.Exit    (exitFailure, exitSuccess)+import           System.Process (readProcess)+import           Text.Regex     (matchRegex, mkRegex)++arguments :: [String]+arguments =+    [ "haddock"+    ]++average :: (Fractional a, Real b) => [b] -> a+average xs = realToFrac (sum xs) / genericLength xs++expected :: Fractional a => a+expected = 100++main :: IO ()+main = do+    output <- readProcess "cabal" arguments ""+    if average (match output) >= expected+        then exitSuccess+        else putStr output >> exitFailure++match :: String -> [Int]+match = fmap read . concat . catMaybes . fmap (matchRegex pattern) . lines+  where+    pattern = mkRegex "^ *([0-9]*)% "

+ test-suite/Hs2048/BoardSpec.hs view

@@ -0,0 +1,146 @@+module Hs2048.BoardSpec (spec) where++import           Hs2048.Board+import qualified Hs2048.Direction as D+import           Test.Hspec++spec :: Spec+spec = do+    describe "canMove" $ do+        it "returns False for []" $ do+            canMove [] D.West `shouldBe` False++        it "can move West" $ do+            canMove [[Nothing, Just 2]] D.West `shouldBe` True++        it "can move South" $ do+            canMove [[Just 2], [Nothing]] D.South `shouldBe` True++        it "can't move East" $ do+            canMove [[Nothing, Just 2]] D.East `shouldBe` False++        it "can't move North" $ do+            canMove [[Just 2], [Nothing]] D.North `shouldBe` False++    describe "canShift" $ do+        it "returns False for []" $ do+            canShift [] `shouldBe` False++        it "returns True if any of the vectors can be shifted" $ do+            canShift [[Nothing, Nothing], [Nothing, Just 2]] `shouldBe` True++    describe "empty" $ do+        it "returns [] for 0 0" $ do+            empty 0 0 `shouldBe` []++        it "returns [[Nothing], [Nothing]] for 1 2" $ do+            empty 1 2 `shouldBe` [[Nothing], [Nothing]]++    describe "emptyPoints" $ do+        it "returns [] for []" $ do+            emptyPoints [] `shouldBe` []++        it "returns the points without tiles" $ do+            emptyPoints [[Nothing, Just 2], [Just 4, Nothing]] `shouldBe`+                [(0, 0), (1, 1)]++    describe "move" $ do+        it "moves West" $ do+            move [[Nothing, Just 2], [Just 4, Nothing]] D.West `shouldBe`+                [[Just 2, Nothing], [Just 4, Nothing]]++        it "moves South" $ do+            move [[Nothing, Just 2], [Just 4, Nothing]] D.South `shouldBe`+                [[Nothing, Nothing], [Just 4, Just 2]]++        it "moves East" $ do+            move [[Nothing, Just 2], [Just 4, Nothing]] D.East `shouldBe`+                [[Nothing, Just 2], [Nothing, Just 4]]++        it "moves North" $ do+            move [[Nothing, Just 2], [Just 4, Nothing]] D.North `shouldBe`+                [[Just 4, Just 2], [Nothing, Nothing]]++    describe "parse" $ do+        it "returns [] for \"\"" $ do+            parse "" `shouldBe` []++        it "returns [[Nothing, Just 2], [Just 4, Just 8]] for \"- 2\n4 8\n\"" $ do+            parse "- 2\n4 8\n" `shouldBe` [[Nothing, Just 2], [Just 4, Just 8]]++    describe "render" $ do+        it "renders []" $ do+            render [] `shouldBe` ""++        it "renders a board" $ do+            render [[Nothing, Just 2], [Just 4, Just 8]] `shouldBe`+                "- 2\n4 8\n"++    describe "rotate" $ do+        it "returns [] for []" $ do+            rotate [] `shouldBe` []++        it "rotates clockwise" $ do+            rotate [[Nothing, Just 2], [Just 4, Just 8]] `shouldBe`+                [[Just 4, Nothing], [Just 8, Just 2]]++    describe "rotateFrom" $ do+        it "rotates West" $ do+            rotateFrom [[Nothing, Just 2], [Just 4, Just 8]] D.West `shouldBe`+                [[Nothing, Just 2], [Just 4, Just 8]]++        it "rotates South" $ do+            rotateFrom [[Nothing, Just 2], [Just 4, Just 8]] D.South `shouldBe`+                [[Just 2, Just 8], [Nothing, Just 4]]++        it "rotates East" $ do+            rotateFrom [[Nothing, Just 2], [Just 4, Just 8]] D.East `shouldBe`+                [[Just 8, Just 4], [Just 2, Nothing]]++        it "rotates North" $ do+            rotateFrom [[Nothing, Just 2], [Just 4, Just 8]] D.North `shouldBe`+                [[Just 4, Nothing], [Just 8, Just 2]]++    describe "rotateTo" $ do+        it "rotates West" $ do+            rotateTo [[Nothing, Just 2], [Just 4, Just 8]] D.West `shouldBe`+                [[Nothing, Just 2], [Just 4, Just 8]]++        it "rotates South" $ do+            rotateTo [[Nothing, Just 2], [Just 4, Just 8]] D.South `shouldBe`+                [[Just 4, Nothing], [Just 8, Just 2]]++        it "rotates East" $ do+            rotateTo [[Nothing, Just 2], [Just 4, Just 8]] D.East `shouldBe`+                [[Just 8, Just 4], [Just 2, Nothing]]++        it "rotates North" $ do+            rotateTo [[Nothing, Just 2], [Just 4, Just 8]] D.North `shouldBe`+                [[Just 2, Just 8], [Nothing, Just 4]]++    describe "score" $ do+        it "returns 0 for []" $ do+            score [] `shouldBe` 0++        it "returns 20 for [[Nothing, Just 2], [Just 4, Just 8]]" $ do+            score [[Nothing, Just 2], [Just 4, Just 8]] `shouldBe` 20++    describe "set" $ do+        it "sets the tile at the point" $ do+            set [[Nothing, Nothing], [Nothing, Nothing]] (Just 2) (0, 0) `shouldBe`+                [[Just 2, Nothing], [Nothing, Nothing]]++    describe "shift" $ do+        it "returns [] for []" $ do+            shift [] `shouldBe` []++        it "shifts toward the heads" $ do+            shift [[Nothing, Just 2], [Nothing, Just 4]] `shouldBe`+                [[Just 2, Nothing], [Just 4, Nothing]]++        it "combines like tiles" $ do+            shift [[Just 2, Just 2]] `shouldBe` [[Just 4, Nothing]]++        it "only combines pairs" $ do+            shift [[Just 2, Just 2, Just 2, Just 2]] `shouldBe`+                [[Just 4, Just 4, Nothing, Nothing]]

+ test-suite/Hs2048/DirectionSpec.hs view

@@ -0,0 +1,46 @@+module Hs2048.DirectionSpec (spec) where++import           Hs2048.Direction+import           Test.Hspec++spec :: Spec+spec = do+    describe "Direction" $ do+        it "is an instance of Bounded" $ do+            minBound `shouldBe` West+            maxBound `shouldBe` North++        it "is an instance of Enum" $ do+            succ West `shouldBe` South+            pred North `shouldBe` East+            toEnum 1 `shouldBe` South+            fromEnum East `shouldBe` 2+            enumFrom North `shouldBe` [North]+            enumFromThen West East `shouldBe` [West, East]+            enumFromTo West West `shouldBe` [West]+            enumFromThenTo West East North `shouldBe` [West, East]++        it "is an instance of Eq" $ do+            West == West `shouldBe` True+            West /= West `shouldBe` False++        it "is an instance of Show" $ do+            show West `shouldBe` "West"+            showList [West] "" `shouldBe` "[West]"++    describe "directions" $ do+        it "returns the directions" $ do+            directions `shouldBe` [West, South, East, North]++    describe "render" $ do+        it "renders West" $ do+            render West `shouldBe` "\x2190"++        it "renders South" $ do+            render South `shouldBe` "\x2193"++        it "renders East" $ do+            render East `shouldBe` "\x2192"++        it "renders North" $ do+            render North `shouldBe` "\x2191"

+ test-suite/Hs2048/GameSpec.hs view

@@ -0,0 +1,112 @@+module Hs2048.GameSpec (spec) where++import           Hs2048.Game+import           System.Random (mkStdGen)+import           Test.Hspec++spec :: Spec+spec = do+    let r = mkStdGen 0++    describe "addRandomTile" $ do+        it "returns id for []" $ do+            fst (addRandomTile [] r) `shouldBe` []++        it "adds a random tile" $ do+            fst (addRandomTile [[Nothing]] r) `shouldBe` [[Just 2]]++        it "returns id when there are no empty tiles" $ do+            fst (addRandomTile [[Just 2]] r) `shouldBe`+                [[Just 2]]++    describe "addRandomTiles" $ do+        it "returns id for 0" $ do+            fst (addRandomTiles 0 [[Nothing]] r) `shouldBe`+                [[Nothing]]++        it "adds a random tile" $ do+            fst (addRandomTiles 1 [[Nothing]] r) `shouldBe`+                [[Just 2]]++        it "adds some random tiles" $ do+            fst (addRandomTiles 2 [[Nothing, Nothing]] r) `shouldBe`+                [[Just 2, Just 2]]++        it "returns id when there are no empty tiles" $ do+            fst (addRandomTiles 1 [[Just 2]] r) `shouldBe`+                [[Just 2]]++    describe "hasWon" $ do+        it "returns False for []" $ do+            hasWon [] `shouldBe` False++        it "returns False without any tiles" $ do+            hasWon [[Nothing]] `shouldBe` False++        it "returns False with no tiles above 2048" $ do+            hasWon [[Just 1024]] `shouldBe` False++        it "returns True with tiles equal to 2048" $ do+            hasWon [[Just 2048]] `shouldBe` True++        it "returns True with tiles above 2048" $ do+            hasWon [[Just 4096]] `shouldBe` True++    describe "isOver" $ do+        it "returns True for []" $ do+            isOver [] `shouldBe` True++        it "returns False if there are empty tiles" $ do+            isOver [[Nothing]] `shouldBe` False++        it "returns False if there are moves" $ do+            isOver [[Just 2, Just 2]] `shouldBe` False++        it "returns True if there are no empty tiles and no moves" $ do+            isOver [[Just 2]] `shouldBe` True++    describe "new" $ do+        it "returns a new game" $ do+            fst (new r) `shouldBe`+                [ [Just 2, Nothing, Nothing, Nothing]+                , [Nothing, Nothing, Nothing, Nothing]+                , [Nothing, Nothing, Nothing, Nothing]+                , [Nothing, Just 2, Nothing, Nothing]+                ]++    describe "randomEmptyIndex" $ do+        it "returns Nothing for []" $ do+            fst (randomEmptyIndex [] r) `shouldBe` Nothing++        it "returns an empty index" $ do+            let g = mkStdGen 0+                v = [Nothing, Nothing]+            fst (randomEmptyIndex v g) `shouldBe` Just 1++        it "returns an empty index" $ do+            let g = mkStdGen 53668+                v = [Nothing, Nothing]+            fst (randomEmptyIndex v g) `shouldBe` Just 0++    describe "randomEmptyPoint" $ do+        it "returns Nothing for []" $ do+            fst (randomEmptyPoint [] r) `shouldBe` Nothing++        it "returns an empty point" $ do+            let g = mkStdGen 0+                b = [[Nothing, Nothing], [Nothing, Nothing]]+            fst (randomEmptyPoint b g) `shouldBe` Just (0, 1)++        it "returns an empty point" $ do+            let g = mkStdGen 2+                b = [[Nothing, Nothing], [Nothing, Nothing]]+            fst (randomEmptyPoint b g) `shouldBe` Just (1, 1)++    describe "randomTile" $ do+        it "returns a 2 tile" $ do+            let g = mkStdGen 0+            fst (randomTile g) `shouldBe` Just 2++        it "returns a 4 tile" $ do+            let g = mkStdGen 1+            fst (randomTile g) `shouldBe` Just 4

+ test-suite/Hs2048/MainSpec.hs view

@@ -0,0 +1,32 @@+module Hs2048.MainSpec (spec) where++import qualified Hs2048.Direction as D+import           Hs2048.Main+import           Test.Hspec++spec :: Spec+spec = do+    describe "direction" $ do+        it "returns Nothing" $ do+            direction "" `shouldBe` Nothing++        it "returns Just West" $ do+            direction "\ESC[D" `shouldBe` Just D.West++        it "returns Just South" $ do+            direction "\ESC[B" `shouldBe` Just D.South++        it "returns Just East" $ do+            direction "\ESC[C" `shouldBe` Just D.East++        it "returns Just North" $ do+            direction "\ESC[A" `shouldBe` Just D.North++    describe "getChars" $ do+        it "is" pending++    describe "getMove" $ do+        it "is" pending++    describe "play" $ do+        it "is" pending

+ test-suite/Hs2048/PointSpec.hs view

@@ -0,0 +1,16 @@+module Hs2048.PointSpec (spec) where++import           Hs2048.Point+import           Test.Hspec++spec :: Spec+spec = do+    let p = (1, 2)++    describe "x" $ do+        it "returns the first value" $ do+            x p `shouldBe` 1++    describe "y" $ do+        it "returns the second value" $ do+            y p `shouldBe` 2

+ test-suite/Hs2048/RendererSpec.hs view

@@ -0,0 +1,31 @@+module Hs2048.RendererSpec (spec) where++import           Hs2048.Renderer+import           Test.Hspec++spec :: Spec+spec = do+    describe "center" $ do+        it "centers a string" $ do+            center 3 "x" `shouldBe` " x "++    describe "color" $ do+        it "returns the color code" $ do+            color Nothing `shouldBe` 30++        it "returns the color code" $ do+            color (Just 2048) `shouldBe` 45++    describe "renderBoard" $ do+        it "renders a board" $ do+            renderBoard [[Nothing, Just 16]] `shouldBe`+                " \ESC[30m-\ESC[0m \ESC[34m16\ESC[0m\n"++    describe "renderGame" $ do+        it "renders a game" $ do+            renderGame [[Nothing, Just 2]] `shouldBe`+                "Score: 0\n\ESC[30m-\ESC[0m \ESC[31m2\ESC[0m\n"++    describe "renderTile" $ do+        it "renders a tile" $ do+            renderTile Nothing `shouldBe` "\ESC[30m-\ESC[0m"

+ test-suite/Hs2048/SettingsSpec.hs view

@@ -0,0 +1,22 @@+module Hs2048.SettingsSpec (spec) where++import           Hs2048.Settings+import           Test.Hspec++spec :: Spec+spec = do+    describe "height" $ do+        it "returns 4" $ do+            height `shouldBe` 4++    describe "maxTile" $ do+        it "returns 2048" $ do+            maxTile `shouldBe` 2048++    describe "tiles" $ do+        it "returns 2" $ do+            tiles `shouldBe` 2++    describe "width" $ do+        it "returns 4" $ do+            width `shouldBe` 4

+ test-suite/Hs2048/TileSpec.hs view

@@ -0,0 +1,39 @@+module Hs2048.TileSpec (spec) where++import           Hs2048.Tile+import           Test.Hspec+import           Test.Hspec.QuickCheck++spec :: Spec+spec = do+    describe "empty" $ do+        it "is Nothing" $ do+            empty `shouldBe` Nothing++    describe "parse" $ do+        it "parses \"-\"" $ do+            parse "-" `shouldBe` Nothing++        prop "parses \"n\"" $ \ n ->+            parse (show n) == Just n++    describe "rank" $ do+        it "ranks Nothing" $ do+            rank Nothing `shouldBe` 0++        prop "ranks Just n" $ \ n ->+            rank (Just n) == floor (logBase (2 :: Double) (fromIntegral n))++    describe "render" $ do+        it "renders Nothing" $ do+            render Nothing `shouldBe` "-"++        prop "renders Just n" $ \ n ->+            render (Just n) == show n++    describe "score" $ do+        it "scores Nothing" $ do+            score Nothing `shouldBe` 0++        prop "scores Just n" $ \ n ->+            score (Just n) == n * (rank (Just n) - 1)

+ test-suite/Hs2048/VectorSpec.hs view

@@ -0,0 +1,59 @@+module Hs2048.VectorSpec (spec) where++import qualified Hs2048.Tile           as T+import           Hs2048.Vector+import           Test.Hspec+import           Test.Hspec.QuickCheck++spec :: Spec+spec = do+    let v1 = replicate 4 Nothing+        v2 = replicate 4 (Just 2)++    describe "canShift" $ do+        it "returns false if the vector can't be shifted" $ do+            canShift v1 `shouldBe` False++        it "returns true if the vector can be shifted" $ do+            canShift v2 `shouldBe` True++    describe "empty" $ do+        prop "returns n empty tiles" $ \ n ->+            -- TODO: There has to be a better way to set bounds.+            (n > 127) || (empty n == replicate n T.empty)++    describe "emptyIndexes" $ do+        it "returns the empty indexes" $ do+            emptyIndexes v1 `shouldBe` [0 .. length v1 - 1]++        it "doesn't return indexes with tiles" $ do+            emptyIndexes v2 `shouldBe` []++    describe "parse" $ do+        it "parses \"- - - -\"" $ do+            parse "- - - -" `shouldBe` v1++        prop "parses \"n n n n\"" $ \ n ->+            parse (unwords (replicate 4 (show n))) == replicate 4 (Just n)++    describe "render" $ do+        it "renders [Nothing, Nothing, Nothing, Nothing]" $ do+            render v1 `shouldBe` "- - - -"++        prop "renders [Just n, Just n, Just n, Just n]" $ \ n ->+            render (replicate 4 (Just n)) == unwords (replicate 4 (show n))++    describe "score" $ do+        it "scores [Nothing, Nothing, Nothing, Nothing]" $ do+            score v1 `shouldBe` 0++        prop "scores [Just n, Just n, Just n, Just n]" $ \ n ->+            score (replicate 4 (Just n)) == 4 * T.score (Just n)++    describe "set" $ do+        it "sets the tile at the index" $ do+            set v1 (Just 2) 0 `shouldBe` [Just 2, Nothing, Nothing, Nothing]++    describe "shift" $ do+        it "shifts the vector" $ do+            shift v2 `shouldBe` [Just 4, Just 4, Nothing, Nothing]

+ test-suite/Hs2048Spec.hs view

@@ -0,0 +1,7 @@+module Hs2048Spec (spec) where++import           Hs2048     ()+import           Test.Hspec++spec :: Spec+spec = it "is" pending

+ test-suite/Spec.hs view

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