{-# Language RankNTypes #-} module GymnasiumSpec where import Gymnasium import Meeple.Operate import Room import Story import Screen import Lens.Micro.Platform import Test.Hspec ng :: (Eq a, Show a) => FilePath -> (Story -> a) -> a -> Expectation ng fp a o = (a <$> testGymnasium fp) `shouldReturn` o ngFalse :: (Eq a, Show a) => FilePath -> (Story -> a) -> a -> Expectation ngFalse fp a o = (a <$> testGymnasium fp) `shouldNotReturn` o vmap :: Functor f => SimpleGetter b c -> SimpleGetter (f b) (f c) vmap lf = to (\a -> a ^. to (fmap (view lf))) spec :: Spec spec = do -- To replay these: -- `cabal new-repl test` and then -- λ> :m +Gymnasium -- λ> narrateGymnasium "test/records/ladder-exit.vr" describe "gymnasium tests" $ do -- COLLISION -- it "does not collide with similar meeple" $ ng "test/records/solid-similar.vr" (\s -> let ms = s ^.. screen . meeples . each . filtered (not . isPlayer) in map (view position) ms) [(7,14), (7, 15)] it "collides diagonally" $ ng "test/records/diagonal-collision.vr" (^. screen . player . vmap position) (Just (23, 15)) it "baddies eat star" $ ng "test/records/eat-star.vr" (^. screen . meeples . to length) 4 -- HAZARDS -- it "dies in the water" $ ng "test/records/water.vr" (^. screen . player . vmap position) (Just (23, 15)) it "baddies die in the water" $ ng "test/records/baddies-die.vr" (^. screen . meeples . to length) 4 -- JUMP -- it "does not skip cells while jumping" $ ng "test/records/jump-tick.vr" (^. stars) 2 it "jumps at 2 height" $ ng "test/records/jump-2.vr" (^. stars) 1 it "jumps at 3 height" $ ng "test/records/jump-2.vr" (^. stars) 1 it "jumps on top of rope" $ ng "test/records/jump-after-rope.vr" (^. stars) 1 it "resets direction when hitting obstacle (fall)" $ ng "test/records/reset-direction.vr" (^. screen . player . vmap position) (Just (23, 50)) -- LADDER -- it "climbs a ladder" $ ng "test/records/ladder.vr" (^. screen . player . vmap position) (Just (12, 65)) it "climbs a ladder connecting two rooms" $ ng "test/records/ladder-exit.vr" (^. screen . room . title) "Gymnasium tre" it "descends a ladder" $ ng "test/records/down-ladder.vr" (^. screen . player . vmap position) (Just (23, 65)) it "falls off a ladder" $ ng "test/records/falls-off-ladder.vr" (^. stars) 0 -- MOVEMENT -- it "stands doing nothing" $ ng "test/records/stand.vr" (^. screen . player . vmap position) (Just (23, 15)) it "space to stop" $ ng "test/records/space-stop.vr" (^. screen . player . vmap position) (Just (23, 30)) it "does not fall through diagonal holes" $ ng "test/records/diagonal-hole.vr" (^. screen . player . vmap position) (Just (12, 70)) it "does not fall through floow in switching rooms" $ ng "test/records/room-switch-ground.vr" (^. screen . room . title) "Gymnasium due" it "allows different-direction meeples" $ ng "test/records/dumb-direction.vr" (^. screen . meeples . to length) 9 it "resets SCI on obstacle" $ ng "test/records/sci-stop.vr" (^. screen . player . vmap position) (Just (20, 30)) it "get stopped by a wall in the next room" $ ng "test/records/stop-next-room.vr" (^. screen . room . title) "Gymnasium tre" it "jumps full height between rooms" $ ng "test/records/jump-between.vr" (^. stars) 2 it "is slow" $ ng "test/records/slow.vr" (^. stars) 0 it "is slow when changing rooms too" $ ng "test/records/slow-rooms.vr" (^. screen . room . title) "Gymnasium tre" -- SPAWNS -- it "respawns in new spawn-point if dead" $ ng "test/records/respawn.vr" (\s -> (s ^. screen . player . vmap position, s ^. screen . room . title)) (Just (23, 41), "Gymnasium due") it "respawns in new old spawn-point if new one not touched" $ ng "test/records/no-touch-spawn.vr" (^. screen . room . title) "Gymnasium uno" it "restarts from last-savepoint" $ ng "test/records/restarts.vr" (\s -> (s ^. screen . player . vmap position, s ^. screen . room . title)) (Just (23, 41), "Gymnasium due") -- BEASTS -- it "smart d walks on rope" $ ng "test/records/smart-rope.vr" (^. screen . player . vmap position) (Just (23, 15)) let isB :: Meeple -> Bool isB (MBird _) = True isB _ = False bird :: HasScreen s => SimpleGetter s Bird bird = meeples . to (filter isB) . to head . to (\(MBird b) -> b) it "bird does not start stuck" $ ngFalse "test/records/bird-start-stuck.vr" (^. screen . bird . position) (12, 18) it "bird does not get stuck" $ ngFalse "test/records/bird-get-stuck.vr" (^. screen . bird . position) (13, 11) it "gets killed by stone" $ ng "test/records/stone-kill.vr" (^. screen . player . vmap position) (Just (23, 4)) it "stone gets destroyes on ground" $ ng "test/records/stone-safe.vr" (^. screen . player . vmap position) (Just (23, 71)) -- krampus it "blades get destroyed on screen exit" $ ng "test/records/blades-destroyed.vr" (^. screen . meeples . to length) 8 it "blades kill player" $ ng "test/records/blades-kill.vr" (^. screen . room . title) "Gymnasium uno" it "blades kill meeple" $ ng "test/records/blades-kill-meeple.vr" (^. screen . room . title) "Gymnasium sei" -- locks it "lock is ground" $ ng "test/records/lock-ground.vr" (^. screen . room . title) "Gymnasium due" it "lock is ground for meeples" $ ng "test/records/lock-ground-meeples.vr" (^. screen . room . title) "Gymnasium uno" it "lock is ground after 1 star" $ ng "test/records/lock-ground-1-star.vr" (^. screen . room . title) "Gymnasium due" it "lock dissipates" $ ng "test/records/lock-away.vr" (^. screen . room . title) "Gymnasium uno" -- star/lock interaction it "Can open lock from another room" $ ng "test/records/star-lock-away.vr" (^. screen . room . title) "Gymnasium uno" it "stars are collectible only once" $ ng "test/records/star-collect.vr" (^. screen . room . title) "Gymnasium due" it "stars are collectible only once (meeple)" $ ng "test/records/star-collect-meeple.vr" (^. stars) 0 -- nettle it "Nettle kills you" $ ng "test/records/nettle-kills.vr" (^. screen . room . title) "Gymnasium uno" it "Nettle kills you not when sleeping" $ ng "test/records/nettle-kills-not.vr" (^. screen . room . title) "Gymnasium sei" -- witch it "kills player" $ ng "test/records/witch-kill.vr" (^. screen . room . title) "Gymnasium uno" it "floats through obstacles" $ ng "test/records/witch-spirit.vr" (^. screen . room . title) "Gymnasium uno"