refactor(gs/xanthous): Use a Word for the level number

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
This commit is contained in:
Griffin Smith 2021-11-06 12:15:01 -04:00 committed by grfn
parent e0bec49b39
commit 580e37ff64
3 changed files with 20 additions and 10 deletions

View file

@ -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

View file

@ -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 {..}

View file

@ -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