Improve structure using Polysemy

app/Main.hs

@@ -7,10 +7,12 @@
 
 module Main where
 
-import           Lib
+import           Data.Function   ((&))
+import           Minesweeper
 import           Options.Generic
-import           System.Random
+import           Polysemy
-import           Text.Read
+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
+  runMinesweeper boardWidth boardLength bombsCount & runTerminalIO & runRandomIO & runM
-  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!"

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

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
-library:
+  - polysemy
-  source-dirs: src/
+  - random
-  exposed-modules:
-    Lib
-  dependencies:
   - containers
   - array
   - split
   - mtl
-    - random
+
+library:
+  source-dirs: src/
 
 executables:
   minesweeper:
@@ -23,7 +34,6 @@ executables:
     main: Main.hs
     dependencies:
       - minesweeper
-      - random
       - optparse-generic
 
 tests:

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!"

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

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