diff options
| -rw-r--r-- | src/Xanthous/App.hs | 3 | ||||
| -rw-r--r-- | src/Xanthous/Data/Levels.hs | 2 | ||||
| -rw-r--r-- | test/Xanthous/Data/LevelsSpec.hs | 6 |
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) -> |