Refactoring, fixes, warnings reduction

README.md

@@ -28,16 +28,44 @@ This project demonstrates the principles of Software Design and Architecture in
 - Free Monad
 - Church Encoded Free Monad
 
+The core idea of the Free monadic frameworks is known as Hierarchical Free Monads.
+
 The project is a showcase for my book [Functional Design and Architecture](https://graninas.com/functional-design-and-architecture-book/). The approaches presented in Hydra are well-described and rationalized in the book, so you may obtain even more info about best practices and ideas of how to write a good Haskell code.
 
 Building dependencies
 =====================
 
 Ubuntu:
-```
+```bash
 $ sudo apt-get install libpg-dev librocksdb-dev
 ```
 
+Building and running
+====================
+
+Use stack for building all the framework and apps:
+
+```bash
+$ stack build
+```
+
+You can also switch the optimizations off and use several threads for building:
+
+```bash
+$ stack build --fast -j4
+```
+
+Running a project is also simple:
+
+```bash
+$ stack exec labyrinth
+```
+
+To load a subproject into GHCi, use the following command:
+
+```bash
+$ stack exec labyrinth:exe:labyrinth
+```
 
 Sample applications
 ===================
@@ -45,10 +73,16 @@ Sample applications
 There are 3 sample applications:
 * [Astro app](app/astro): web server (with servant) and CLI client tool which allows to track meteors (tool for astronomers).
 * [PerfTestApp](app/PerfTestApp): an application you can run to measure the performance of the three engines.
+* [PerfTestApp2](app/PerfTestApp2): another application you can run to measure the performance of the three engines.
 * [MeteorCounter](app/MeteorCounter): application which demonstrates the usage of STM and multithreading using three engines.
+* [Labyrinth](app/labyrinth): a game about exploring the labyrinth with a CLI interactive interface.
 
-Sample SQL-related code
-=======================
+Code samples
+============
+
+###
+
+### Sample SQL-related code
 
 ```haskell
 createMeteor :: MeteorTemplate -> D.SqlConn BS.SqliteM -> L.AppL MeteorId
@@ -88,11 +122,12 @@ createMeteor mtp@(MeteorTemplate {..}) conn = do
   pure $ SqlDB._meteorId $ fromJust m
 ```
 
-**Additional materials describing these ideas:**
+# Additional materials
+
+Checkout the following materials to learn more about he Hierarchical Free Monads approach used in Hydra:
 
 - [Hierarchical Free Monads: The Most Developed Approach In Haskell (And The Death Of Final Tagless)](https://github.com/graninas/hierarchical-free-monads-the-most-developed-approach-in-haskell)
 - [Hierarchical Free Monads and Software Design in Functional Programming (Talk, Eng)](https://www.youtube.com/watch?v=3GKQ4ni2pS0) | [Slides (Eng)](https://docs.google.com/presentation/d/1SYMIZ-LOI8Ylykz0PTxwiPuHN_02gIWh9AjJDO6xbvM/edit?usp=sharing)
 - [Final Tagless vs Free Monad (Talk, Rus)](https://www.youtube.com/watch?v=u1GGqDQyGfc) | [Slides (Eng)](https://docs.google.com/presentation/d/1VhS8ySgk2w5RoN_l_Ar_axcE4Dzf97zLw1uuzUJQbCo/edit?usp=sharing)
 - [Automatic Whitebox Testing with Free Monads (Talk, Eng)](https://www.youtube.com/watch?v=-cp2BDlwi-M) | [Slides (Eng)](https://docs.google.com/presentation/d/1KJj0OIUdSmkEmWo_u0P1ZyCw28wqpNx8VXClKjpIzEo/edit?usp=sharing)
 - [Automatic whitebox testing with Free Moands (Showcase, Article)](https://github.com/graninas/automatic-whitebox-testing-showcase)
-

app/labyrinth/src/Labyrinth/App.hs

@@ -75,7 +75,7 @@ testMove st dir = do
       (MonolithWall, _)        -> ImpossibleMove "Step impossible: monolith wall"
       (RegularWall, _)         -> ImpossibleMove "Step impossible: wall"
       (Passage, Nothing)       -> InvalidMove $ "Cell not found: " +|| nextPos ||+ ""
-      (Passage, Just (cell, content)) -> SuccessfullMove nextPos cell content
+      (Passage, Just (nextCell, nextContent)) -> SuccessfullMove nextPos nextCell nextContent
       (Exit, _)                -> ExitFound hasTreasure
 
 getPlayerPos :: AppState -> LangL Pos
@@ -152,7 +152,7 @@ makeMove st dir = do
     InvalidMove msg     -> throwException $ InvalidOperation msg
     ImpossibleMove msg  -> addMoveMessage st msg
     ExitFound hasTreasure -> setGameState st $ PlayerIsAboutLeaving hasTreasure
-    SuccessfullMove newPos cell content -> do
+    SuccessfullMove newPos _ _ -> do
       addMoveMessage st "Step executed."
       setPlayerPos st newPos
       performPlayerContentEvent st

app/labyrinth/src/Labyrinth/Domain.hs

@@ -1,6 +1,5 @@
 module Labyrinth.Domain where
 
-import qualified Data.Text as T
 import qualified Data.Map as Map
 
 import Labyrinth.Prelude as L

app/labyrinth/src/Labyrinth/Gen.hs

@@ -1,6 +1,5 @@
 module Labyrinth.Gen where
 
-import qualified Data.Text     as T
 import qualified Data.Map      as Map
 
 import Labyrinth.Prelude

app/labyrinth/src/Labyrinth/Labyrinths.hs

@@ -3,7 +3,6 @@ module Labyrinth.Labyrinths where
 import qualified Data.Map  as Map
 
 import           Labyrinth.Prelude
-import           Labyrinth.Types
 import           Labyrinth.Domain
 
 testLabyrinth1 :: Labyrinth

app/labyrinth/src/Labyrinth/Prelude.hs

@@ -1,14 +1,13 @@
 module Labyrinth.Prelude
   ( module X
   , putStrLn
+  , putTextLn
   ) where
 
-import           Hydra.Prelude as X hiding (retry, atomically, putStrLn)
+import           Hydra.Prelude as X hiding (retry, atomically, putStrLn, putTextLn)
 import qualified Hydra.Prelude as PP
-import qualified Prelude as P
 import qualified Data.Text as T
 
-import qualified Hydra.Domain               as D
 import qualified Hydra.Language             as L
 import           Hydra.Language             as X
 import           Hydra.Domain               as X
@@ -17,4 +16,4 @@ putTextLn :: Text -> L.LangL ()
 putTextLn = L.evalIO . PP.putStrLn
 
 putStrLn :: String -> L.LangL ()
-putStrLn = L.evalIO . PP.putStrLn . T.pack
+putStrLn = putTextLn . T.pack

app/labyrinth/src/Labyrinth/Render.hs

@@ -2,7 +2,6 @@ module Labyrinth.Render where
 
 import           Labyrinth.Prelude
 
-import qualified Data.Text                  as T
 import qualified Data.Map                   as Map
 
 import           Labyrinth.Types
@@ -50,6 +49,7 @@ mergeCellContent NoContent _ = fullSpace
 mergeCellContent Treasure _ = "T   "
 mergeCellContent (Wormhole n) _ | n < 10 = "  W" <> show n
 mergeCellContent (Wormhole n) _ | n >= 10 = "  W?"
+mergeCellContent content renderedContent = error $ "mergeCellContent: unexpected arguments: " <> show content <> ", " <> show renderedContent
 
 mergeCell :: Direction -> Wall -> String -> String
 mergeCell dir NoWall curW |

app/labyrinth/src/Labyrinth/Types.hs

@@ -2,9 +2,6 @@
 
 module Labyrinth.Types where
 
-import qualified Data.Text                  as T
-import qualified Data.Map                   as Map
-
 import           Labyrinth.Prelude          as L
 import           Labyrinth.Domain
 

app/labyrinth/src/Main.hs

@@ -2,8 +2,6 @@ module Main where
 
 import           Labyrinth.Prelude
 
-import qualified Data.Map                   as Map
-
 import qualified Hydra.Domain               as D
 import qualified Hydra.Runtime              as R
 import qualified Hydra.Interpreters         as R
@@ -26,7 +24,7 @@ loggerCfg = D.LoggerConfig
 
 initAppState :: Labyrinth -> AppL AppState
 initAppState lab = do
-  let (bounds@(x, y), wormholes) = analyzeLabyrinth lab
+  let (bounds, wormholes) = analyzeLabyrinth lab
   let renderTemplate = renderSkeleton bounds
 
   labRenderVar     <- newVarIO renderTemplate