Initial demo for a guessing game (n ? it's more : it's less)

.gitignore

@@ -0,0 +1,3 @@
+dist*/
+.ghc.environment.*
+PlusOuMoins.hs

CHANGELOG.md

@@ -0,0 +1,5 @@
+# Revision history for PlusOuMoins
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.

LICENSE

@@ -0,0 +1,30 @@
+Copyright (c) 2019, Tissevert
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Tissevert nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

PlusOuMoins.cabal

@@ -0,0 +1,35 @@
+cabal-version:       >=1.10
+-- Initial package description 'PlusOuMoins.cabal' generated by 'cabal
+-- init'.  For further documentation, see
+-- http://haskell.org/cabal/users-guide/
+
+name:                PlusOuMoins
+version:             0.1.0.0
+synopsis:            A game where one has to guess a number
+-- description:
+homepage:            https://git.marvid.fr/Tissevert/PlusOuMoins
+-- bug-reports:
+license:             BSD3
+license-file:        LICENSE
+author:              Tissevert
+maintainer:          tissevert+devel@marvid.fr
+-- copyright:
+category:            Game
+build-type:          Simple
+extra-source-files:  CHANGELOG.md
+
+executable PlusOuMoins
+  main-is:             Main.hs
+  other-modules:       Level
+                     , Menu
+                     , MainMenu
+                     , Mode
+                     , Utils
+  -- other-extensions:
+  build-depends:       base >=4.11 && <4.12
+                     , ansi-terminal
+                     , mtl
+                     , random
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall

Setup.hs

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

monolith.sh

@@ -0,0 +1,50 @@
+#!/bin/bash
+
+SRCDIR=src
+MODULES=(Utils Menu Level Mode MainMenu)
+MAIN_MODULE=Main
+
+PRAGMA_PATTERN='^{-# LANGUAGE [a-zA-Z]\+ #-}$'
+IMPORT_PATTERN='^import '
+
+sourceFile()
+{
+  printf "${SRCDIR}/${1}.hs"
+}
+
+pragmas()
+{
+  grep -rh "${PRAGMA_PATTERN}" "${SRCDIR}" | sort -u
+}
+
+imports()
+{
+  local modulesPattern="$(echo ${MODULES[@]} | sed 's: :\\|:g')"
+  grep -rh "${IMPORT_PATTERN}" "${SRCDIR}" | grep -v "\(${modulesPattern}\)" | sort -u
+}
+
+body()
+{
+  grep -vh "${PRAGMA_PATTERN}" "$(sourceFile "${1}")" |\
+    uncork |\
+    grep -v "${IMPORT_PATTERN}" |\
+    cat -s
+}
+
+uncork()
+{
+  LINE="null"
+  while ([ -z "${LINE}" ] || [ -n "${LINE%%module*}" ]); do read LINE; done
+  while [ -n "${LINE}" ]; do read LINE; done
+  cat
+}
+
+pragmas
+grep '^module' "$(sourceFile ${MAIN_MODULE})"
+printf "\n"
+imports
+for module in ${MODULES[@]}
+do
+  body "${module}"
+done
+body "${MAIN_MODULE}"

src/Level.hs

@@ -0,0 +1,21 @@
+module Level (Level(..), bounds) where
+
+import Menu (Menu(..), Promptable(..))
+
+data Level = Easy | Normal | Hard deriving (Enum, Bounded)
+
+instance Promptable Level where
+  menu = Menu {
+        title = "Choix du niveau de difficulte"
+      , question = "Entrez le numero du mode qui vous interesse : "
+      , invalidText = "Votre choix n'est pas valide, merci de taper 1, 2 ou 3 selon le niveau de difficulte que vous souhaitez activer."
+    }
+
+  showOption Easy = "Facile : le nombre a trouver est compris entre 1 et 100" 
+  showOption Normal = "Moyen : le nombre a trouver est compris entre 1 et 1000"
+  showOption Hard = "Difficile : le nombre a trouver est compris entre 1 et 10000"
+
+bounds :: Level -> (Int, Int)
+bounds Easy = (1, 100)
+bounds Normal = (1, 1000)
+bounds Hard = (1, 10000)

src/Main.hs

@@ -0,0 +1,101 @@
+{-# LANGUAGE NamedFieldPuns #-}
+module Main where
+
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.State (StateT, evalStateT, gets, modify, put)
+import Level (Level(..), bounds)
+import Menu (formatTitle, select)
+import MainMenu (MainMenu(..))
+import Mode (Mode(..))
+import System.Console.ANSI (clearScreen)
+import System.Random (randomRIO)
+import Text.Printf (printf)
+import Utils (outputLn, prompt)
+
+data Settings = Settings {
+      level :: Level
+    , mode :: Mode
+  }
+
+defaultSettings :: Settings
+defaultSettings = Settings {level = Easy, mode = OnePlayer}
+
+type Game = StateT Settings IO
+
+initPlay :: Settings -> Game Int
+initPlay (Settings {mode, level}) = do
+  liftIO clearScreen
+  case mode of
+    OnePlayer -> initOnePlayer $ bounds level
+    PlayerVsPlayer -> initPlayerVsPlayer $ bounds level
+
+initOnePlayer :: (Int, Int) -> Game Int
+initOnePlayer range@(minNumber, maxNumber) = do
+  mapM_ outputLn $ formatTitle "Mode un joueur, vous jouez contre moi."
+  outputLn (
+      printf "J'ai choisi un nombre compris entre %d et %d, a vous de deviner lequel" minNumber maxNumber
+    )
+  liftIO $ randomRIO range
+
+initPlayerVsPlayer :: (Int, Int) -> Game Int
+initPlayerVsPlayer range@(minNumber, maxNumber) = do
+  mapM_ outputLn $ formatTitle "Mode deux joueurs"
+  mapM_ outputLn [
+        printf "L'un des joueurs doit choisir secretement un nombre compris entre %d et %d que le deuxieme joueur va essayer de deviner." minNumber maxNumber
+      , "Écrivez le nombre choisi sans que l'autre joueur ne le voit : "
+    ]
+  numberToGuess <- getSecretNumber range
+  liftIO clearScreen
+  outputLn "Le nombre choisi a ete enregistre, c'est au deuxieme joueur de le trouver."
+  return numberToGuess
+
+getSecretNumber :: MonadIO m => (Int, Int) -> m Int
+getSecretNumber range = prompt (return ()) (outputLn $ warning range) range
+  where
+    warning = uncurry (printf "Merci de choisir un nombre compris ENTRE %d et %d : ")
+
+guess :: Int -> (Int, Int) -> StateT Int IO Int
+guess expected range = do
+  n <- prompt (modify (+1) >> outputLn "Dites un nombre : ") onError range
+  case n of
+    _ | n < expected -> outputLn "C'est plus" >> guess expected range
+      | n > expected -> outputLn "C'est moins" >> guess expected range
+      | otherwise -> outputLn (found n) >> gets id
+  where
+    warning = printf "Pour rappel, le nombre choisi est compris entre %d et %d"
+    onError = outputLn (uncurry warning range)
+    found = printf "Excellent! Il fallait effectivement trouver le nombre %d"
+
+play :: Game ()
+play = do
+  numberToGuess <- initPlay =<< gets id
+  range <- gets (bounds . level)
+  steps <- liftIO $ evalStateT (guess numberToGuess range) 0
+  outputLn (printf "Bravo!!! Vous avez trouvé en %s." $ numberOfSteps steps)
+  select >>= dispatch
+  where
+    numberOfSteps 1 = "1 coup"
+    numberOfSteps n = printf "%d coups" n
+
+settings :: Game ()
+settings = do
+  level <- select
+  outputLn (printf "Vous jouez en mode %s." $ showLevel level)
+  mode <- select
+  put $ Settings {level, mode}
+  select >>= dispatch
+  where
+    showLevel Easy = "facile"
+    showLevel Normal = "moyen"
+    showLevel Hard = "difficile"
+
+dispatch :: MainMenu -> Game ()
+dispatch Play = play
+dispatch ChangeSettings = settings
+dispatch Quit = return ()
+
+main :: IO ()
+main = do
+  clearScreen
+  putStrLn "=====> JEU DU PLUS OU MOINS <====="
+  evalStateT (select >>= dispatch) defaultSettings

src/MainMenu.hs

@@ -0,0 +1,15 @@
+module MainMenu (MainMenu(..)) where
+
+import Menu (Menu(..), Promptable(..))
+
+data MainMenu = Play | ChangeSettings | Quit deriving (Enum, Bounded)
+
+instance Promptable MainMenu where
+  menu = Menu {
+        title = "Menu principal"
+      , question = "Choisissez une action"
+      , invalidText = "Ce choix n'est pas valide"
+    }
+  showOption Play = "Jouer"
+  showOption ChangeSettings = "Changer les réglages"
+  showOption Quit = "Quitter"

src/Menu.hs

@@ -0,0 +1,40 @@
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+module Menu (
+      Menu(..)
+    , Promptable(..)
+    , formatTitle
+    , select
+  ) where
+
+import Control.Monad.IO.Class (MonadIO(..))
+import Text.Printf (printf)
+import Utils (outputLn, prompt)
+
+data Menu a = Menu {
+      title :: String
+    , question :: String
+    , invalidText :: String
+  }
+
+formatTitle :: String -> [String]
+formatTitle aTitle = [line, formattedTitle, line]
+  where
+    formattedTitle = "==> " ++ aTitle
+    line = const '-' <$> formattedTitle
+
+formatOption :: Promptable a => a -> String
+formatOption o = printf "%d. %s" (fromEnum o) (showOption o)
+
+class (Bounded a, Enum a) => Promptable a where
+  menu :: Menu a
+  showOption :: a -> String
+
+select :: forall a m. (MonadIO m, Promptable a) => m a
+select = toEnum <$> prompt
+  (mapM_ outputLn (formatTitle title ++ options ++ [question]))
+  (outputLn invalidText)
+  (fromEnum (minBound :: a), fromEnum (maxBound :: a))
+  where
+    Menu {title, question, invalidText} = (menu :: Menu a)
+    options = formatOption <$> ([minBound .. maxBound] :: [a])

src/Mode.hs

@@ -0,0 +1,15 @@
+module Mode (Mode(..)) where
+
+import Menu (Menu(..), Promptable(..))
+
+data Mode = OnePlayer | PlayerVsPlayer deriving (Enum, Bounded)
+
+instance Promptable Mode where
+  menu = Menu {
+        title = "Choix du mode de jeu"
+      , question = "Entrez le numero du mode qui vous interesse : "
+      , invalidText = "Votre choix n'est pas valide, merci de taper 1 ou 2 selon le mode de jeu que vous souhaitez activer."
+    }
+
+  showOption OnePlayer = "Mode un joueur"
+  showOption PlayerVsPlayer = "Mode deux joueurs"

src/Utils.hs

@@ -0,0 +1,19 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+module Utils (
+      outputLn
+    , prompt
+  ) where
+
+import Control.Monad.IO.Class (MonadIO(..))
+import Text.Read (readMaybe)
+
+outputLn :: MonadIO m => String -> m ()
+outputLn = liftIO . putStrLn
+
+prompt :: MonadIO m => m () -> m () -> (Int, Int) -> m Int
+prompt message onError range@(minVal, maxVal) = do
+  message
+  mn <- readMaybe <$> liftIO getLine
+  case mn of
+    Just n | n >= minVal && n <= maxVal -> return n
+    _ -> onError >> prompt message onError range