diff options
author | Griffin Smith <grfn@gws.fyi> | 2021-11-06T16·15-0400 |
---|---|---|
committer | grfn <grfn@gws.fyi> | 2021-11-06T17·34+0000 |
commit | 580e37ff64b47f46cbafe39e448847320295f591 (patch) | |
tree | 558756464c48b657974a769cbdc72d05fdd82f78 /users/grfn | |
parent | e0bec49b39313751c44c0b36026828cedfa5ae8d (diff) |
refactor(gs/xanthous): Use a Word for the level number r/3010
Using a signed Int here is a little silly, since we can never have negative levels. Change-Id: Ibe03be5014226e07dfa6f78d8360301bc1b7c9b1 Reviewed-on: https://cl.tvl.fyi/c/depot/+/3803 Reviewed-by: grfn <grfn@gws.fyi> Tested-by: BuildkiteCI
Diffstat (limited to 'users/grfn')
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/App.hs | 2 | ||||
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Data/Levels.hs | 22 | ||||
-rw-r--r-- | users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs | 6 |
3 files changed, 20 insertions, 10 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/App.hs b/users/grfn/xanthous/src/Xanthous/App.hs index 369f6ae2ff9e..bf6a63e086ce 100644 --- a/users/grfn/xanthous/src/Xanthous/App.hs +++ b/users/grfn/xanthous/src/Xanthous/App.hs @@ -566,7 +566,7 @@ showPanel panel = do -------------------------------------------------------------------------------- genLevel - :: Int -- ^ level number + :: Word -- ^ Level number, starting at 0 -> AppM Level genLevel _num = do let dims = Dimensions 80 80 diff --git a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs b/users/grfn/xanthous/src/Xanthous/Data/Levels.hs index efc0f53acecf..13251d8afdf2 100644 --- a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs +++ b/users/grfn/xanthous/src/Xanthous/Data/Levels.hs @@ -5,6 +5,7 @@ module Xanthous.Data.Levels ( Levels , allLevels + , numLevels , nextLevel , prevLevel , mkLevels1 @@ -46,20 +47,23 @@ import Test.QuickCheck newtype Levels a = Levels { levelZipper :: Zipper Seq a } deriving stock (Generic) deriving (Functor, Comonad, Foldable) via (Zipper Seq) - deriving (ComonadStore Int) via (Zipper Seq) type instance Element (Levels a) = a instance MonoFoldable (Levels a) instance MonoFunctor (Levels a) instance MonoTraversable (Levels a) +instance ComonadStore Word Levels where + pos = toEnum . pos . levelZipper + peek i = peek (fromEnum i) . levelZipper + instance Traversable Levels where traverse f (Levels z) = Levels <$> traverse f z instance Foldable1 Levels instance Traversable1 Levels where - traverse1 f (Levels z) = seek (pos z) . partialMkLevels <$> go (unzipper z) + traverse1 f levs@(Levels z) = seek (pos levs) . partialMkLevels <$> go (unzipper z) where go Empty = error "empty seq, unreachable" go (x :<| xs) = (<|) <$> f x <.> go xs @@ -71,6 +75,12 @@ instance Semigroup (Levels a) where . partialMkLevels $ allLevels levs₁ <> allLevels levs₂ +-- | The number of levels stored in 'Levels' +-- +-- Equivalent to 'Data.Foldable.length', but likely faster +numLevels :: Levels a -> Word +numLevels = toEnum . size . levelZipper + -- | Make Levels from a Seq. Throws an error if the seq is not empty partialMkLevels :: Seq a -> Levels a partialMkLevels = Levels . fromJust . zipper @@ -98,7 +108,7 @@ nextLevel -> Levels level -> m (Levels level) nextLevel genLevel levs - | pos levs + 1 < size (levelZipper levs) + | succ (pos levs) < numLevels levs = pure $ seeks succ levs | otherwise = genLevel <&> \level -> @@ -115,7 +125,7 @@ prevLevel levs | pos levs == 0 = Nothing -- various operations data AltLevels a = AltLevels { _levels :: NonEmpty a - , _currentLevel :: Int -- ^ invariant: is within the bounds of _levels + , _currentLevel :: Word -- ^ invariant: is within the bounds of _levels } deriving stock (Show, Eq, Generic) deriving anyclass (NFData, CoArbitrary, Function) @@ -150,11 +160,11 @@ instance FromJSON a => FromJSON (Levels a) where instance Arbitrary a => Arbitrary (AltLevels a) where arbitrary = do _levels <- arbitrary - _currentLevel <- choose (0, length _levels - 1) + _currentLevel <- choose (0, pred . toEnum . length $ _levels) pure AltLevels {..} shrink als = do _levels <- shrink $ als ^. levels - _currentLevel <- filter (between 0 $ length _levels - 1) + _currentLevel <- filter (between 0 $ pred . toEnum . length $ _levels) $ shrink $ als ^. currentLevel pure AltLevels {..} diff --git a/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs b/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs index 4e46946a93b0..a7528331627d 100644 --- a/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs +++ b/users/grfn/xanthous/test/Xanthous/Data/LevelsSpec.hs @@ -33,13 +33,13 @@ test = testGroup "Xanthous.Data.Levels" === pos levels + 1 , testProperty "maintains the invariant" $ \(levels :: Levels Int) genned -> let levels' = runIdentity . nextLevel (Identity genned) $ levels - in between 0 (length levels') $ pos 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 (length levels - 1) levels + let levels' = seek (toEnum $ length levels - 1) levels levels'' = runIdentity . nextLevel (Identity genned) $ levels' in counterexample (show levels'') $ extract levels'' === genned @@ -52,7 +52,7 @@ test = testGroup "Xanthous.Data.Levels" , testProperty "maintains the invariant" $ \(levels :: Levels Int) -> case prevLevel levels of Nothing -> property Discard - Just levels' -> property $ between 0 (length levels') $ pos levels' + Just levels' -> property $ between 0 (toEnum $ length levels') $ pos levels' , testProperty "extract is total" $ \(levels :: Levels Int) -> case prevLevel levels of Nothing -> property Discard |