diff options
author | Aspen Smith <grfn@gws.fyi> | 2024-02-12T03·00-0500 |
---|---|---|
committer | clbot <clbot@tvl.fyi> | 2024-02-14T19·37+0000 |
commit | 82ecd61f5c699cf3af6c4eadf47a1c52b1d696c6 (patch) | |
tree | 429c5e078528000591742ec3211bc768ae913a78 /users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs | |
parent | 0ba476a4266015f278f18d74094299de74a5a111 (diff) |
chore(users): grfn -> aspen r/7511
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809 Autosubmit: aspen <root@gws.fyi> Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI Reviewed-by: lukegb <lukegb@tvl.fyi>
Diffstat (limited to 'users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs')
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs | 66 |
1 files changed, 0 insertions, 66 deletions
diff --git a/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs deleted file mode 100644 index a7528331627d..000000000000 --- a/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs +++ /dev/null @@ -1,66 +0,0 @@ --------------------------------------------------------------------------------- -module Xanthous.Data.LevelsSpec (main, test) where --------------------------------------------------------------------------------- -import Test.Prelude --------------------------------------------------------------------------------- -import qualified Data.Aeson as JSON --------------------------------------------------------------------------------- -import Xanthous.Util (between) -import Xanthous.Data.Levels --------------------------------------------------------------------------------- - -main :: IO () -main = defaultMain test - -test :: TestTree -test = testGroup "Xanthous.Data.Levels" - [ testGroup "current" - [ testProperty "view is extract" $ \(levels :: Levels Int) -> - levels ^. current === extract levels - , testProperty "set replaces current" $ \(levels :: Levels Int) new -> - extract (set current new levels) === new - , testProperty "set extract is id" $ \(levels :: Levels Int) -> - set current (extract levels) levels === levels - , testProperty "set y ∘ set x ≡ set y" $ \(levels :: Levels Int) x y -> - set current y (set current x levels) === set current y levels - ] - , localOption (QuickCheckTests 20) - $ testBatch $ semigroup @(Levels Int) (error "unused", 1 :: Int) - , testGroup "next/prev" - [ testGroup "nextLevel" - [ testProperty "seeks forwards" $ \(levels :: Levels Int) genned -> - (pos . runIdentity . nextLevel (Identity genned) $ levels) - === pos levels + 1 - , testProperty "maintains the invariant" $ \(levels :: Levels Int) genned -> - let levels' = runIdentity . nextLevel (Identity genned) $ levels - in between 0 (toEnum $ length levels') $ pos 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 (toEnum $ 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) -> - case prevLevel levels of - Nothing -> property Discard - Just levels' -> pos levels' === pos levels - 1 - , testProperty "maintains the invariant" $ \(levels :: Levels Int) -> - case prevLevel levels of - Nothing -> property Discard - Just levels' -> property $ between 0 (toEnum $ length levels') $ pos levels' - , testProperty "extract is total" $ \(levels :: Levels Int) -> - case prevLevel levels of - Nothing -> property Discard - Just levels' -> total $ extract levels' - ] - ] - , testGroup "JSON" - [ testProperty "toJSON/parseJSON round-trip" $ \(levels :: Levels Int) -> - JSON.decode (JSON.encode levels) === Just levels - ] - ] |