about summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--src/Xanthous/App.hs3
-rw-r--r--src/Xanthous/Data/Levels.hs2
-rw-r--r--test/Xanthous/Data/LevelsSpec.hs6
3 files changed, 8 insertions, 3 deletions
diff --git a/src/Xanthous/App.hs b/src/Xanthous/App.hs
index 2fd821af1cf7..577466328101 100644
--- a/src/Xanthous/App.hs
+++ b/src/Xanthous/App.hs
@@ -300,8 +300,7 @@ handleCommand GoDown = do
     let newLevelNum = Levels.pos levs + 1
     levs' <- nextLevel (levelToEntityMap <$> genLevel newLevelNum) levs
     cEID <- use characterEntityID
-    pCharacter <- use $ entities . at cEID
-    entities . at cEID .= Nothing
+    pCharacter <- entities . at cEID <<.= Nothing
     levels .= levs'
     entities . at cEID .= pCharacter
   else say_ ["cant", "goDown"]
diff --git a/src/Xanthous/Data/Levels.hs b/src/Xanthous/Data/Levels.hs
index 5fc3f9334138..efc0f53acecf 100644
--- a/src/Xanthous/Data/Levels.hs
+++ b/src/Xanthous/Data/Levels.hs
@@ -102,7 +102,7 @@ nextLevel genLevel levs
   = pure $ seeks succ levs
   | otherwise
   = genLevel <&> \level ->
-      seek (pos levs + 1) . partialMkLevels $ level <| allLevels levs
+      seek (pos levs + 1) . partialMkLevels $ allLevels levs |> level
 
 -- | Go to the previous level. Returns Nothing if 'pos' is 0
 prevLevel :: Levels level -> Maybe (Levels level)
diff --git a/test/Xanthous/Data/LevelsSpec.hs b/test/Xanthous/Data/LevelsSpec.hs
index 49d3719b1272..4e46946a93b0 100644
--- a/test/Xanthous/Data/LevelsSpec.hs
+++ b/test/Xanthous/Data/LevelsSpec.hs
@@ -37,6 +37,12 @@ test = testGroup "Xanthous.Data.Levels"
       , testProperty "extract is total" $ \(levels :: Levels Int) genned ->
           let levels' = runIdentity . nextLevel (Identity genned) $ levels
           in total $ extract levels'
+      , testProperty "uses the generated level as the next level"
+        $ \(levels :: Levels Int) genned ->
+          let levels' = seek (length levels - 1) levels
+              levels'' = runIdentity . nextLevel (Identity genned) $ levels'
+          in counterexample (show levels'')
+             $ extract levels'' === genned
       ]
     , testGroup "prevLevel"
       [ testProperty "seeks backwards" $ \(levels :: Levels Int) ->