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

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