diff --git a/app/Main.hs b/app/Main.hs index 6e34175..103d49e 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,10 +7,12 @@ module Main where -import Lib +import Data.Function ((&)) +import Minesweeper import Options.Generic -import System.Random -import Text.Read +import Polysemy +import Random +import Terminal data Parameters w = Parameters @@ -27,36 +29,4 @@ deriving instance Show (Parameters Unwrapped) main :: IO () main = do (Parameters boardWidth boardLength bombsCount) <- unwrapRecord "Minesweeper" - generator <- newStdGen - gameStep . createBoard boardWidth boardLength $ - generateRandomCoordinates (boardWidth - 1) (boardLength - 1) bombsCount generator - -gameStep :: Board -> IO () -gameStep board = do - putStrLn . convertBoardToString $ board - coordinates <- getCoordinates - let nextBoard = revealTile coordinates board - if isGameLost nextBoard - then gameLost nextBoard - else if isGameWon nextBoard - then gameWon nextBoard - else gameStep nextBoard - -getCoordinates :: IO (Int, Int) -getCoordinates = do - putStrLn "Enter the coordinates of the tile to reveal (X then Y, zero indexed):" - xString <- getLine - yString <- getLine - case (readMaybe xString, readMaybe yString) of - (Just x, Just y) -> return (x, y) - _ -> putStrLn "Invalid coordinates!" >> getCoordinates - -gameLost :: Board -> IO () -gameLost board = do - putStrLn . convertBoardToString . revealAll $ board - putStrLn "Boom! You lost!" - -gameWon :: Board -> IO () -gameWon board = do - putStrLn . convertBoardToString $ board - putStrLn "You won! All the bombs were found!" + runMinesweeper boardWidth boardLength bombsCount & runTerminalIO & runRandomIO & runM diff --git a/minesweeper.cabal b/minesweeper.cabal index 24359a6..192c2d4 100644 --- a/minesweeper.cabal +++ b/minesweeper.cabal @@ -4,7 +4,7 @@ cabal-version: 1.12 -- -- see: https://github.com/sol/hpack -- --- hash: ae0d0337fef94e96da9aaca377817a7cbca70851243db8fe2a6c435fe06f0cfa +-- hash: e5b75ea7d51fb62c97c99a49ccb242a54d64422d7f1eeb101b67b94c40681c02 name: minesweeper version: 0.1.0.0 @@ -13,16 +13,22 @@ build-type: Simple library exposed-modules: Lib + Minesweeper + Random + Terminal other-modules: Paths_minesweeper hs-source-dirs: src/ - ghc-options: -Wall + default-extensions: DataKinds FlexibleContexts GADTs LambdaCase PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeOperators TypeFamilies + ghc-options: -Wall -O2 -flate-specialise -fspecialise-aggressively -fplugin=Polysemy.Plugin build-depends: array , base , containers , mtl + , polysemy + , polysemy-plugin , random , split default-language: Haskell2010 @@ -33,12 +39,19 @@ executable minesweeper Paths_minesweeper hs-source-dirs: app/ - ghc-options: -Wall + default-extensions: DataKinds FlexibleContexts GADTs LambdaCase PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeOperators TypeFamilies + ghc-options: -Wall -O2 -flate-specialise -fspecialise-aggressively -fplugin=Polysemy.Plugin build-depends: - base + array + , base + , containers , minesweeper + , mtl , optparse-generic + , polysemy + , polysemy-plugin , random + , split default-language: Haskell2010 test-suite minesweeper-test @@ -48,10 +61,18 @@ test-suite minesweeper-test Paths_minesweeper hs-source-dirs: test/ - ghc-options: -Wall + default-extensions: DataKinds FlexibleContexts GADTs LambdaCase PolyKinds RankNTypes ScopedTypeVariables TypeApplications TypeOperators TypeFamilies + ghc-options: -Wall -O2 -flate-specialise -fspecialise-aggressively -fplugin=Polysemy.Plugin build-depends: - base + array + , base + , containers , minesweeper + , mtl + , polysemy + , polysemy-plugin + , random + , split , tasty , tasty-hunit default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 75ff961..1a2b0cd 100644 --- a/package.yaml +++ b/package.yaml @@ -1,21 +1,32 @@ name: minesweeper version: 0.1.0.0 -ghc-options: -Wall +ghc-options: -Wall -O2 -flate-specialise -fspecialise-aggressively -fplugin=Polysemy.Plugin + +default-extensions: + - DataKinds + - FlexibleContexts + - GADTs + - LambdaCase + - PolyKinds + - RankNTypes + - ScopedTypeVariables + - TypeApplications + - TypeOperators + - TypeFamilies dependencies: - base + - base + - polysemy-plugin + - polysemy + - random + - containers + - array + - split + - mtl library: source-dirs: src/ - exposed-modules: - Lib - dependencies: - - containers - - array - - split - - mtl - - random executables: minesweeper: @@ -23,7 +34,6 @@ executables: main: Main.hs dependencies: - minesweeper - - random - optparse-generic tests: diff --git a/src/Minesweeper.hs b/src/Minesweeper.hs new file mode 100644 index 0000000..c18783d --- /dev/null +++ b/src/Minesweeper.hs @@ -0,0 +1,46 @@ +module Minesweeper where + +import Lib +import Polysemy +import Random +import Terminal +import Text.Read + +runMinesweeper :: + Member Terminal r + => Member Random r => + Int -> Int -> Int -> Sem r () +runMinesweeper boardWidth boardLength bombsCount = do + generator <- newGenerator + gameStep . createBoard boardWidth boardLength $ + generateRandomCoordinates (boardWidth - 1) (boardLength - 1) bombsCount generator + +gameStep :: Member Terminal r => Board -> Sem r () +gameStep board = do + printLine . convertBoardToString $ board + coordinates <- runGetCoordinates + let nextBoard = revealTile coordinates board + if isGameLost nextBoard + then runGameLost nextBoard + else if isGameWon nextBoard + then runGameWon nextBoard + else gameStep nextBoard + +runGetCoordinates :: Member Terminal r => Sem r (Int, Int) +runGetCoordinates = do + printLine "Enter the coordinates of the tile to reveal (X then Y, zero indexed):" + xString <- readLine + yString <- readLine + case (readMaybe xString, readMaybe yString) of + (Just x, Just y) -> return (x, y) + _ -> printLine "Invalid coordinates!" >> runGetCoordinates + +runGameLost :: Member Terminal r => Board -> Sem r () +runGameLost board = do + printLine . convertBoardToString . revealAll $ board + printLine "Boom! You lost!" + +runGameWon :: Member Terminal r => Board -> Sem r () +runGameWon board = do + printLine . convertBoardToString $ board + printLine "You won! All the bombs were found!" \ No newline at end of file diff --git a/src/Random.hs b/src/Random.hs new file mode 100644 index 0000000..5516ef4 --- /dev/null +++ b/src/Random.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Random where + +import Polysemy +import qualified System.Random as R + +data Random m a where + NewGenerator :: Random m R.StdGen + +makeSem ''Random + +runRandomIO :: Member (Embed IO) r => Sem (Random ': r) a -> Sem r a +runRandomIO = + interpret $ \case + NewGenerator -> embed R.newStdGen \ No newline at end of file diff --git a/src/Terminal.hs b/src/Terminal.hs new file mode 100644 index 0000000..cf62b9d --- /dev/null +++ b/src/Terminal.hs @@ -0,0 +1,17 @@ +{-# LANGUAGE TemplateHaskell #-} + +module Terminal where + +import Polysemy + +data Terminal m a where + PrintLine :: String -> Terminal m () + ReadLine :: Terminal m String + +makeSem ''Terminal + +runTerminalIO :: Member (Embed IO) r => Sem (Terminal ': r) a -> Sem r a +runTerminalIO = + interpret $ \case + PrintLine line -> embed $ putStrLn line + ReadLine -> embed getLine \ No newline at end of file