Initial commit

This commit is contained in:
Paul-Henri Froidmont 2019-11-24 02:49:57 +01:00 committed by Paul-Henri Froidmont
commit 4e77f37a5f
9 changed files with 289 additions and 0 deletions

3
.gitignore vendored Normal file
View file

@ -0,0 +1,3 @@
.idea
*.iml
.stack-work

2
Setup.hs Normal file
View file

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

10
app/Main.hs Normal file
View file

@ -0,0 +1,10 @@
module Main where
import Lib
main :: IO ()
main = putStrLn $ printBoard (Board
[ [Bomb Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed]
])

51
minesweeper.cabal Normal file
View file

@ -0,0 +1,51 @@
cabal-version: 1.12
-- This file has been generated from package.yaml by hpack version 0.31.1.
--
-- see: https://github.com/sol/hpack
--
-- hash: 73d25bfaacbe65c083033b14864aa14b133058ca0e7c877622a08afb39ca460c
name: minesweeper
version: 0.1.0.0
build-type: Simple
library
exposed-modules:
Lib
other-modules:
Paths_minesweeper
hs-source-dirs:
src/
ghc-options: -Wall
build-depends:
base
, containers
default-language: Haskell2010
executable minesweeper
main-is: Main.hs
other-modules:
Paths_minesweeper
hs-source-dirs:
app/
ghc-options: -Wall
build-depends:
base
, minesweeper
default-language: Haskell2010
test-suite minesweeper-test
type: exitcode-stdio-1.0
main-is: Spec.hs
other-modules:
Paths_minesweeper
hs-source-dirs:
test/
ghc-options: -Wall
build-depends:
base
, minesweeper
, tasty
, tasty-hunit
default-language: Haskell2010

30
package.yaml Normal file
View file

@ -0,0 +1,30 @@
name: minesweeper
version: 0.1.0.0
ghc-options: -Wall
dependencies:
base
library:
source-dirs: src/
exposed-modules:
Lib
dependencies:
- containers
executables:
minesweeper:
source-dirs: app/
main: Main.hs
dependencies:
minesweeper
tests:
minesweeper-test:
source-dirs: test/
main: Spec.hs
dependencies:
- minesweeper
- tasty
- tasty-hunit

66
src/Lib.hs Normal file
View file

@ -0,0 +1,66 @@
module Lib
( flagTile
, printBoard
, Board(..)
, Tile(..)
, TileState(..)
) where
newtype Board =
Board
{ unBoard :: [[Tile]]
}
deriving (Eq, Show)
data Tile
= Value Int TileState
| Bomb TileState
deriving (Eq, Show)
data TileState
= Revealed
| Flagged
| Hidden
deriving (Eq, Show)
type Coordinates = (Int, Int)
flagTile :: Board -> Coordinates -> Board
flagTile (Board board) (x, y) =
case findTile (Board board) (x, y) of
(Just tile) -> flagHiddenTile tile
Nothing -> Board board
where
flagHiddenTile (Value value Hidden) = replaceTile (Board board) (x, y) (Value value Flagged)
flagHiddenTile (Bomb Hidden) = replaceTile (Board board) (x, y) (Bomb Flagged)
flagHiddenTile _ = Board board
replaceTile :: Board -> Coordinates -> Tile -> Board
replaceTile (Board board) (x, y) tile =
let (firstRows, line:lastRows) = splitAt y board
(firstTiles, _:lastTiles) = splitAt x line
in Board $ firstRows ++ (firstTiles ++ tile : lastTiles) : lastRows
findTile :: Board -> Coordinates -> Maybe Tile
findTile (Board board) (x, y) =
if not (coordinatesExists (Board board) (x, y))
then Nothing
else Just $ board !! y !! x
coordinatesExists :: Board -> Coordinates -> Bool
coordinatesExists (Board board) (x, y) = isPositive && isYWithinTheBoard board && isXWithinTheBoard board
where
isPositive = x >= 0 && y >= 0
isYWithinTheBoard = (> y) . length
isXWithinTheBoard = any ((> x) . length)
printBoard :: Board -> String
printBoard (Board board) = concatMap printLine board
where
printLine line = concatMap printTile line ++ "\n"
printTile (Bomb Hidden) = "#"
printTile (Bomb Revealed) = "B"
printTile (Value _ Hidden) = "#"
printTile (Value x Revealed) = show x
printTile (Bomb Flagged) = "F"
printTile (Value _ Flagged) = "F"

66
stack.yaml Normal file
View file

@ -0,0 +1,66 @@
# This file was automatically generated by 'stack init'
#
# Some commonly used options have been documented as comments in this file.
# For advanced use and comprehensive documentation of the format, please see:
# https://docs.haskellstack.org/en/stable/yaml_configuration/
# Resolver to choose a 'specific' stackage snapshot or a compiler version.
# A snapshot resolver dictates the compiler version and the set of packages
# to be used for project dependencies. For example:
#
# resolver: lts-3.5
# resolver: nightly-2015-09-21
# resolver: ghc-7.10.2
#
# The location of a snapshot can be provided as a file or url. Stack assumes
# a snapshot provided as a file might change, whereas a url resource does not.
#
# resolver: ./custom-snapshot.yaml
# resolver: https://example.com/snapshots/2018-01-01.yaml
resolver: lts-14.14
# User packages to be built.
# Various formats can be used as shown in the example below.
#
# packages:
# - some-directory
# - https://example.com/foo/bar/baz-0.0.2.tar.gz
# subdirs:
# - auto-update
# - wai
packages:
- .
# Dependency packages to be pulled from upstream that are not in the resolver.
# These entries can reference officially published versions as well as
# forks / in-progress versions pinned to a git hash. For example:
#
# extra-deps:
# - acme-missiles-0.3
# - git: https://github.com/commercialhaskell/stack.git
# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
#
# extra-deps: []
# Override default flag values for local packages and extra-deps
# flags: {}
# Extra package databases containing global packages
# extra-package-dbs: []
# Control whether we use the GHC we find on the path
# system-ghc: true
#
# Require a specific version of stack, using version ranges
# require-stack-version: -any # Default
# require-stack-version: ">=2.1"
#
# Override the architecture used by stack, especially useful on Windows
# arch: i386
# arch: x86_64
#
# Extra directories used by stack for building
# extra-include-dirs: [/path/to/dir]
# extra-lib-dirs: [/path/to/dir]
#
# Allow a newer minor version of GHC than the snapshot specifies
# compiler-check: newer-minor

12
stack.yaml.lock Normal file
View file

@ -0,0 +1,12 @@
# This file was autogenerated by Stack.
# You should not edit this file by hand.
# For more information, please see the documentation at:
# https://docs.haskellstack.org/en/stable/lock_files
packages: []
snapshots:
- completed:
size: 525663
url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/14.yaml
sha256: 6edc48df46eb8bf7b861e98dd30d021a92c2e1820c9bb6528aac5d997b0e14ef
original: lts-14.14

49
test/Spec.hs Normal file
View file

@ -0,0 +1,49 @@
import Lib
import Test.Tasty
import Test.Tasty.HUnit
main :: IO ()
main = defaultMain $ testGroup "Minesweeper tests" [flagTileTest]
emptyBoard :: Board
emptyBoard = Board [[]]
hiddenBoard :: Board
hiddenBoard =
Board
[ [Bomb Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
]
revealedBoard :: Board
revealedBoard =
Board
[ [Bomb Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 1 Revealed, Value 1 Revealed, Value 0 Revealed]
, [Value 0 Revealed, Value 0 Revealed, Value 0 Revealed]
]
flagTileTest :: TestTree
flagTileTest =
testGroup
"Flag tile"
[ testCase "Empty board" $ flagTile emptyBoard (1, 1) @?= emptyBoard
, testCase "Flag bomb tile" $
flagTile hiddenBoard (0, 0) @?=
Board
[ [Bomb Flagged, Value 1 Hidden, Value 0 Hidden]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
]
, testCase "Flag value tile" $
flagTile hiddenBoard (2, 0) @?=
Board
[ [Bomb Hidden, Value 1 Hidden, Value 0 Flagged]
, [Value 1 Hidden, Value 1 Hidden, Value 0 Hidden]
, [Value 0 Hidden, Value 0 Hidden, Value 0 Hidden]
]
, testCase "Flag revealed bomb tile" $ flagTile revealedBoard (0, 0) @?= revealedBoard
, testCase "Flag revealed value tile" $ flagTile revealedBoard (1, 2) @?= revealedBoard
]