about summary refs log tree commit diff
path: root/users/grfn/xanthous/src/Xanthous/Data
diff options
context:
space:
mode:
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Data')
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/App.hs47
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/Entities.hs68
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs56
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs276
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs72
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/Levels.hs180
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/Memo.hs98
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs227
-rw-r--r--users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs100
9 files changed, 0 insertions, 1124 deletions
diff --git a/users/grfn/xanthous/src/Xanthous/Data/App.hs b/users/grfn/xanthous/src/Xanthous/Data/App.hs
deleted file mode 100644
index 13c4b5d61068..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/App.hs
+++ /dev/null
@@ -1,47 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Data.App
-  ( Panel(..)
-  , ResourceName(..)
-  , AppEvent(..)
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
---------------------------------------------------------------------------------
-import Test.QuickCheck
-import Test.QuickCheck.Instances.Text ()
-import Data.Aeson (ToJSON, FromJSON)
---------------------------------------------------------------------------------
-import Xanthous.Util.QuickCheck
---------------------------------------------------------------------------------
-
--- | Enum for "panels" displayed in the game's UI.
-data Panel
-  = -- | A panel providing help with the game's commands
-    HelpPanel
-  | -- | A panel displaying the character's inventory
-    InventoryPanel
-  | -- | A panel describing an item in the inventory in detail
-    --
-    -- The argument is the full description of the item
-    ItemDescriptionPanel Text
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary Panel
-
-
-data ResourceName
-  = MapViewport -- ^ The main viewport where we display the game content
-  | Character   -- ^ The character
-  | MessageBox  -- ^ The box where we display messages to the user
-  | Prompt      -- ^ The game's prompt
-  | Panel Panel -- ^ A panel in the game
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary ResourceName
-
-data AppEvent
-  = AutoContinue -- ^ Continue whatever autocommand has been requested by the
-                 --   user
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function, ToJSON, FromJSON)
-  deriving Arbitrary via GenericArbitrary AppEvent
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Entities.hs b/users/grfn/xanthous/src/Xanthous/Data/Entities.hs
deleted file mode 100644
index 39953410f2f3..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Entities.hs
+++ /dev/null
@@ -1,68 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE RecordWildCards #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.Entities
-  ( -- * Collisions
-    Collision(..)
-  , _Stop
-  , _Combat
-    -- * Entity Attributes
-  , EntityAttributes(..)
-  , blocksVision
-  , blocksObject
-  , collision
-  , defaultEntityAttributes
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
---------------------------------------------------------------------------------
-import           Data.Aeson (ToJSON(..), FromJSON(..), (.:?), (.!=), withObject)
-import           Data.Aeson.Generic.DerivingVia
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
-import           Test.QuickCheck
---------------------------------------------------------------------------------
-
-data Collision
-  = Stop   -- ^ Can't move through this
-  | Combat -- ^ Moving into this equates to hitting it with a stick
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary Collision
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ AllNullaryToStringTag 'True ]
-           Collision
-makePrisms ''Collision
-
--- | Attributes of an entity
-data EntityAttributes = EntityAttributes
-  { _blocksVision :: Bool
-    -- | Does this entity block a large object from being put in the same tile as
-    -- it - eg a a door being closed on it
-  , _blocksObject :: Bool
-    -- | What type of collision happens when moving into this entity?
-  , _collision :: Collision
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary EntityAttributes
-  deriving (ToJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           EntityAttributes
-makeLenses ''EntityAttributes
-
-instance FromJSON EntityAttributes where
-  parseJSON = withObject "EntityAttributes" $ \o -> do
-    _blocksVision <- o .:? "blocksVision"
-                      .!= _blocksVision defaultEntityAttributes
-    _blocksObject <- o .:? "blocksObject"
-                      .!= _blocksObject defaultEntityAttributes
-    _collision    <- o .:? "collision"
-                      .!= _collision defaultEntityAttributes
-    pure EntityAttributes {..}
-
-defaultEntityAttributes :: EntityAttributes
-defaultEntityAttributes = EntityAttributes
-  { _blocksVision = False
-  , _blocksObject = False
-  , _collision    = Stop
-  }
diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs
deleted file mode 100644
index 855a3462daee..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityChar.hs
+++ /dev/null
@@ -1,56 +0,0 @@
-{-# LANGUAGE RoleAnnotations      #-}
-{-# LANGUAGE RecordWildCards      #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE GADTs                #-}
-{-# LANGUAGE AllowAmbiguousTypes  #-}
-{-# LANGUAGE TemplateHaskell      #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.EntityChar
-  ( EntityChar(..)
-  , HasChar(..)
-  , HasStyle(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding ((.=))
---------------------------------------------------------------------------------
-import qualified Graphics.Vty.Attributes as Vty
-import           Test.QuickCheck
-import           Data.Aeson
---------------------------------------------------------------------------------
-import           Xanthous.Orphans ()
-import           Xanthous.Util.QuickCheck (GenericArbitrary(..))
---------------------------------------------------------------------------------
-
-
-class HasChar s a | s -> a where
-  char :: Lens' s a
-  {-# MINIMAL char #-}
-
-data EntityChar = EntityChar
-  { _char :: Char
-  , _style :: Vty.Attr
-  }
-  deriving stock (Show, Eq, Ord, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving Arbitrary via GenericArbitrary EntityChar
-makeFieldsNoPrefix ''EntityChar
-
-instance FromJSON EntityChar where
-  parseJSON (String (chr :< Empty)) = pure $ EntityChar chr Vty.defAttr
-  parseJSON (Object o) = do
-    (EntityChar _char _) <- o .: "char"
-    _style <- o .:? "style" .!= Vty.defAttr
-    pure EntityChar {..}
-  parseJSON _ = fail "Invalid type, expected string or object"
-
-instance ToJSON EntityChar where
-  toJSON (EntityChar chr styl)
-    | styl == Vty.defAttr = String $ chr <| Empty
-    | otherwise = object
-      [ "char" .= chr
-      , "style" .= styl
-      ]
-
-instance IsString EntityChar where
-  fromString [ch] = EntityChar ch Vty.defAttr
-  fromString _ = error "Entity char must only be a single character"
diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs
deleted file mode 100644
index 33a98f1ae5a9..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityMap.hs
+++ /dev/null
@@ -1,276 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE DeriveTraversable  #-}
-{-# LANGUAGE TupleSections      #-}
-{-# LANGUAGE TemplateHaskell    #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveFunctor      #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.EntityMap
-  ( EntityMap
-  , _EntityMap
-  , EntityID
-  , emptyEntityMap
-  , insertAt
-  , insertAtReturningID
-  , fromEIDsAndPositioned
-  , toEIDsAndPositioned
-  , atPosition
-  , atPositionWithIDs
-  , positions
-  , lookup
-  , lookupWithPosition
-  , positionOf
-  -- , positionedEntities
-  , neighbors
-  , Deduplicate(..)
-
-  -- * debug
-  , byID
-  , byPosition
-  , lastID
-
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude hiding (lookup)
-import Xanthous.Data
-  ( Position
-  , Positioned(..)
-  , positioned
-  , Neighbors(..)
-  , neighborPositions, position
-  )
-import Xanthous.Data.VectorBag
-import Xanthous.Orphans ()
-import Xanthous.Util (EqEqProp(..))
---------------------------------------------------------------------------------
-import Data.Monoid (Endo(..))
-import Test.QuickCheck (Arbitrary(..), CoArbitrary, Function)
-import Test.QuickCheck.Checkers (EqProp)
-import Test.QuickCheck.Instances.UnorderedContainers ()
-import Test.QuickCheck.Instances.Vector ()
-import Text.Show (showString, showParen)
-import Data.Aeson
---------------------------------------------------------------------------------
-
-type EntityID = Word32
-type NonNullSet a = NonNull (Set a)
-
-data EntityMap a where
-  EntityMap ::
-    { _byPosition :: Map Position (NonNullSet EntityID)
-    , _byID       :: HashMap EntityID (Positioned a)
-    , _lastID     :: EntityID
-    } -> EntityMap a
-  deriving stock (Functor, Foldable, Traversable, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-deriving via (EqEqProp (EntityMap a)) instance (Eq a, Ord a) => EqProp (EntityMap a)
-makeLenses ''EntityMap
-
-instance ToJSON a => ToJSON (EntityMap a) where
-  toJSON = toJSON . toEIDsAndPositioned
-
-
-instance FromJSON a => FromJSON (EntityMap a) where
-  parseJSON = fmap (fromEIDsAndPositioned @[_]) . parseJSON
-
-byIDInvariantError :: forall a. a
-byIDInvariantError = error $ "Invariant violation: All EntityIDs in byPosition "
-  <> "must point to entityIDs in byID"
-
-instance (Ord a, Eq a) => Eq (EntityMap a) where
-  -- em₁ == em₂ = em₁ ^. _EntityMap == em₂ ^. _EntityMap
-  (==) = (==) `on` view (_EntityMap . to sort)
-
-deriving stock instance (Ord a) => Ord (EntityMap a)
-
-instance Show a => Show (EntityMap a) where
-  showsPrec pr em
-    = showParen (pr > 10)
-    $ showString
-    . ("fromEIDsAndPositioned " <>)
-    . show
-    . toEIDsAndPositioned
-    $ em
-
-instance Arbitrary a => Arbitrary (EntityMap a) where
-  arbitrary = review _EntityMap <$> arbitrary
-  shrink em = review _EntityMap <$> shrink (em ^. _EntityMap)
-
-type instance Index (EntityMap a) = EntityID
-type instance IxValue (EntityMap a) = (Positioned a)
-instance Ixed (EntityMap a) where ix eid = at eid . traverse
-
-instance At (EntityMap a) where
-  at eid = lens (view $ byID . at eid) setter
-    where
-      setter :: EntityMap a -> Maybe (Positioned a) -> EntityMap a
-      setter m Nothing = fromMaybe m $ do
-        Positioned pos _ <- m ^. byID . at eid
-        pure $ m
-          & removeEIDAtPos pos
-          & byID . at eid .~ Nothing
-      setter m (Just pe@(Positioned pos _)) = m
-        & (case lookupWithPosition eid m of
-             Nothing -> id
-             Just (Positioned origPos _) -> removeEIDAtPos origPos
-          )
-        & byID . at eid ?~ pe
-        & byPosition . at pos %~ \case
-            Nothing -> Just $ opoint eid
-            Just es -> Just $ ninsertSet eid es
-      removeEIDAtPos pos =
-        byPosition . at pos %~ (>>= fromNullable . ndeleteSet eid)
-
-instance Semigroup (EntityMap a) where
-  em₁ <> em₂ = alaf Endo foldMap (uncurry insertAt) (em₂ ^. _EntityMap) em₁
-
-instance Monoid (EntityMap a) where
-  mempty = emptyEntityMap
-
-instance FunctorWithIndex EntityID EntityMap
-
-instance FoldableWithIndex EntityID EntityMap
-
-instance TraversableWithIndex EntityID EntityMap where
-  itraverse = itraverseOf itraversed
-
-type instance Element (EntityMap a) = a
-instance MonoFoldable (EntityMap a)
-
-emptyEntityMap :: EntityMap a
-emptyEntityMap = EntityMap mempty mempty 0
-
-newtype Deduplicate a = Deduplicate (EntityMap a)
-  deriving stock (Show, Traversable, Generic)
-  deriving newtype (Eq, Functor, Foldable, EqProp, Arbitrary)
-
-instance Semigroup (Deduplicate a) where
-  (Deduplicate em₁) <> (Deduplicate em₂) =
-    let _byID = em₁ ^. byID <> em₂ ^. byID
-        _byPosition = mempty &~ do
-          ifor_ _byID $ \eid (Positioned pos _) ->
-            at pos %= \case
-              Just eids -> Just $ ninsertSet eid eids
-              Nothing -> Just $ opoint eid
-        _lastID = fromMaybe 1 $ maximumOf (ifolded . asIndex) _byID
-    in Deduplicate EntityMap{..}
-
-
---------------------------------------------------------------------------------
-
-_EntityMap :: Iso' (EntityMap a) [(Position, a)]
-_EntityMap = iso hither yon
-  where
-    hither :: EntityMap a -> [(Position, a)]
-    hither em = do
-       (pos, eids) <- em ^. byPosition . _Wrapped
-       eid <- toList eids
-       ent <- em ^.. byID . at eid . folded . positioned
-       pure (pos, ent)
-    yon :: [(Position, a)] -> EntityMap a
-    yon poses = alaf Endo foldMap (uncurry insertAt) poses emptyEntityMap
-
-
-insertAtReturningID :: forall a. Position -> a -> EntityMap a -> (EntityID, EntityMap a)
-insertAtReturningID pos e em =
-  let (eid, em') = em & lastID <+~ 1
-  in em'
-     & byID . at eid ?~ Positioned pos e
-     & byPosition . at pos %~ \case
-       Nothing -> Just $ opoint eid
-       Just es -> Just $ ninsertSet eid es
-     & (eid, )
-
-insertAt :: forall a. Position -> a -> EntityMap a -> EntityMap a
-insertAt pos e = snd . insertAtReturningID pos e
-
-atPosition :: forall a. (Ord a, Show a) => Position -> Lens' (EntityMap a) (VectorBag a)
-atPosition pos = lens getter setter
-  where
-    getter em =
-      let eids :: VectorBag EntityID
-          eids = maybe mempty (VectorBag . toVector . toNullable)
-                 $ em ^. byPosition . at pos
-      in getEIDAssume em <$> eids
-    setter em Empty = em & byPosition . at pos .~ Nothing
-    setter em (sort -> entities) =
-      let origEIDs = maybe Empty toNullable $ em ^. byPosition . at pos
-          origEntitiesWithIDs =
-            sortOn snd $ toList origEIDs <&> \eid -> (eid, getEIDAssume em eid)
-          go alles₁@((eid, e₁) :< es₁) -- orig
-             (e₂ :< es₂)               -- new
-            | e₁ == e₂
-              -- same, do nothing
-            = let (eids, lastEID, byID') = go es₁ es₂
-              in (insertSet eid eids, lastEID, byID')
-            | otherwise
-              -- e₂ is new, generate a new ID for it
-            = let (eids, lastEID, byID') = go alles₁ es₂
-                  eid' = succ lastEID
-              in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos e₂)
-          go Empty Empty = (mempty, em ^. lastID, em ^. byID)
-          go orig Empty =
-            let byID' = foldr deleteMap (em ^. byID) $ map fst orig
-            in (mempty, em ^. lastID, byID')
-          go Empty (new :< news) =
-            let (eids, lastEID, byID') = go Empty news
-                eid' = succ lastEID
-            in (insertSet eid' eids, eid', byID' & at eid' ?~ Positioned pos new)
-          go _ _ = error "unreachable"
-          (eidsAtPosition, newLastID, newByID) = go origEntitiesWithIDs entities
-      in em & byPosition . at pos .~ fromNullable eidsAtPosition
-            & byID .~ newByID
-            & lastID .~ newLastID
-
-getEIDAssume :: EntityMap a -> EntityID -> a
-getEIDAssume em eid = fromMaybe byIDInvariantError
-  $ em ^? byID . ix eid . positioned
-
-atPositionWithIDs :: Position -> EntityMap a -> Vector (EntityID, Positioned a)
-atPositionWithIDs pos em =
-  let eids = maybe mempty (toVector . toNullable)
-             $ em ^. byPosition . at pos
-  in (id &&& Positioned pos . getEIDAssume em) <$> eids
-
-fromEIDsAndPositioned
-  :: forall mono a. (MonoFoldable mono, Element mono ~ (EntityID, Positioned a))
-  => mono
-  -> EntityMap a
-fromEIDsAndPositioned eps = newLastID $ alaf Endo foldMap insert' eps mempty
-  where
-    insert' (eid, pe@(Positioned pos _))
-      = (byID . at eid ?~ pe)
-      . (byPosition . at pos %~ \case
-            Just eids -> Just $ ninsertSet eid eids
-            Nothing   -> Just $ opoint eid
-        )
-    newLastID em = em & lastID
-      .~ fromMaybe 1
-         (maximumOf (ifolded . asIndex) (em ^. byID))
-
-toEIDsAndPositioned :: EntityMap a -> [(EntityID, Positioned a)]
-toEIDsAndPositioned = itoListOf $ byID . ifolded
-
-positions :: EntityMap a -> [Position]
-positions = toListOf $ byPosition . to keys . folded
-
-lookupWithPosition :: EntityID -> EntityMap a -> Maybe (Positioned a)
-lookupWithPosition eid = view $ byID . at eid
-
-lookup :: EntityID -> EntityMap a -> Maybe a
-lookup eid = fmap (view positioned) . lookupWithPosition eid
-
--- unlawful :(
--- positionedEntities :: IndexedTraversal EntityID (EntityMap a) (EntityMap b) (Positioned a) (Positioned b)
--- positionedEntities = byID . itraversed
-
-neighbors :: (Ord a, Show a) => Position -> EntityMap a -> Neighbors (VectorBag a)
-neighbors pos em = (\p -> view (atPosition p) em) <$> neighborPositions pos
-
--- | Traversal to the position of the entity with the given ID
-positionOf :: EntityID -> Traversal' (EntityMap a) Position
-positionOf eid = ix eid . position
-
---------------------------------------------------------------------------------
-makeWrapped ''Deduplicate
diff --git a/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs b/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
deleted file mode 100644
index 1398c611cf20..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/EntityMap/Graphics.hs
+++ /dev/null
@@ -1,72 +0,0 @@
---------------------------------------------------------------------------------
-module Xanthous.Data.EntityMap.Graphics
-  ( visiblePositions
-  , visibleEntities
-  , lineOfSight
-  , linesOfSight
-  , canSee
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude hiding (lines)
---------------------------------------------------------------------------------
-import Xanthous.Util (takeWhileInclusive)
-import Xanthous.Data
-import Xanthous.Data.Entities
-import Xanthous.Data.EntityMap
-import Xanthous.Game.State
-import Xanthous.Util.Graphics (circle, line)
---------------------------------------------------------------------------------
-
--- | Returns a set of positions that are visible, when taking into account
--- 'blocksVision', from the given position, within the given radius.
-visiblePositions
-  :: Entity e
-  => Position
-  -> Word -- ^ Vision radius
-  -> EntityMap e
-  -> Set Position
-visiblePositions pos radius
-  = setFromList . positions . visibleEntities pos radius
-
--- | Returns a list of entities on the *line of sight* from the first position
--- to the second position
-lineOfSight
-  :: forall e. Entity e
-  => Position -- ^ Origin
-  -> Position -- ^ Destination
-  -> EntityMap e
-  -> [(Position, Vector (EntityID, e))]
-lineOfSight (view _Position -> origin) (view _Position -> destination) em =
-  takeWhileInclusive (none (view blocksVision . entityAttributes . snd) . snd)
-    $ getPositionedAt <$> line origin destination
-  where
-    getPositionedAt :: V2 Int -> (Position, Vector (EntityID, e))
-    getPositionedAt (review _Position -> p) =
-      (p, over _2 (view positioned) <$> atPositionWithIDs p em)
-
--- | Returns a list of individual lines of sight, each of which is a list of
--- entities at positions on that line of sight
-linesOfSight
-  :: forall e. Entity e
-  => Position    -- ^ Centerpoint
-  -> Word        -- ^ Radius
-  -> EntityMap e
-  -> [[(Position, Vector (EntityID, e))]]
-linesOfSight pos visionRadius em =
-  radius <&> \edge -> lineOfSight pos (_Position # edge) em
-  where
-    radius = circle (pos ^. _Position) $ fromIntegral visionRadius
-
--- | Given a point and a radius of vision, returns a list of all entities that
--- are *visible* (eg, not blocked by an entity that obscures vision) from that
--- point
-visibleEntities :: Entity e => Position -> Word -> EntityMap e -> EntityMap e
-visibleEntities pos visionRadius
-  = fromEIDsAndPositioned
-  . foldMap (\(p, es) -> over _2 (Positioned p) <$> es)
-  . fold
-  . linesOfSight pos visionRadius
-
-canSee :: Entity e => (e -> Bool) -> Position -> Word -> EntityMap e -> Bool
-canSee match pos radius = any match . visibleEntities pos radius
--- ^ this might be optimizable
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs b/users/grfn/xanthous/src/Xanthous/Data/Levels.hs
deleted file mode 100644
index 13251d8afdf2..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Levels.hs
+++ /dev/null
@@ -1,180 +0,0 @@
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.Levels
-  ( Levels
-  , allLevels
-  , numLevels
-  , nextLevel
-  , prevLevel
-  , mkLevels1
-  , mkLevels
-  , oneLevel
-  , current
-  , ComonadStore(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding ((<.>), Empty, foldMap)
-import           Xanthous.Util (between, EqProp, EqEqProp(..))
-import           Xanthous.Util.Comonad (current)
-import           Xanthous.Orphans ()
---------------------------------------------------------------------------------
-import           Control.Comonad.Store
-import           Control.Comonad.Store.Zipper
-import           Data.Aeson (ToJSON(..), FromJSON(..))
-import           Data.Aeson.Generic.DerivingVia
-import           Data.Functor.Apply
-import           Data.Foldable (foldMap)
-import           Data.List.NonEmpty (NonEmpty)
-import qualified Data.List.NonEmpty as NE
-import           Data.Maybe (fromJust)
-import           Data.Sequence (Seq((:<|), Empty))
-import           Data.Semigroup.Foldable.Class
-import           Data.Text (replace)
-import           Test.QuickCheck
---------------------------------------------------------------------------------
-
--- | Collection of levels plus a pointer to the current level
---
--- Navigation is via the 'Comonad' instance. We can get the current level with
--- 'extract':
---
---     extract @Levels :: Levels level -> level
---
--- For access to and modification of the level, use
--- 'Xanthous.Util.Comonad.current'
-newtype Levels a = Levels { levelZipper :: Zipper Seq a }
-    deriving stock (Generic)
-    deriving (Functor, Comonad, Foldable) 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 levs@(Levels z) = seek (pos levs) . partialMkLevels <$> go (unzipper z)
-    where
-      go Empty = error "empty seq, unreachable"
-      go (x :<| xs) = (<|) <$> f x <.> go xs
-
--- | Always takes the position of the latter element
-instance Semigroup (Levels a) where
-  levs₁ <> levs₂
-    = seek (pos levs₂)
-    . 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
-
--- | Make Levels from a possibly-empty structure
-mkLevels :: Foldable1 f => f level -> Maybe (Levels level)
-mkLevels = fmap Levels . zipper . foldMap pure
-
--- | Make Levels from a non-empty structure
-mkLevels1 :: Foldable1 f => f level -> Levels level
-mkLevels1 = fromJust . mkLevels
-
-oneLevel :: a -> Levels a
-oneLevel = mkLevels1 . Identity
-
--- | Get a sequence of all the levels
-allLevels :: Levels a -> Seq a
-allLevels = unzipper . levelZipper
-
--- | Step to the next level, generating a new level if necessary using the given
--- applicative action
-nextLevel
-  :: Applicative m
-  => m level -- ^ Generate a new level, if necessary
-  -> Levels level
-  -> m (Levels level)
-nextLevel genLevel levs
-  | succ (pos levs) < numLevels levs
-  = pure $ seeks succ levs
-  | otherwise
-  = genLevel <&> \level ->
-      seek (pos levs + 1) . partialMkLevels $ allLevels levs |> level
-
--- | Go to the previous level. Returns Nothing if 'pos' is 0
-prevLevel :: Levels level -> Maybe (Levels level)
-prevLevel levs | pos levs == 0 = Nothing
-               | otherwise = Just $ seeks pred levs
-
---------------------------------------------------------------------------------
-
--- | alternate, slower representation of Levels we can Iso into to perform
--- various operations
-data AltLevels a = AltLevels
-  { _levels :: NonEmpty a
-  , _currentLevel :: Word -- ^ invariant: is within the bounds of _levels
-  }
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
-  deriving (ToJSON, FromJSON)
-       via WithOptions '[ FieldLabelModifier '[Drop 1] ]
-           (AltLevels a)
-makeLenses ''AltLevels
-
-alt :: Iso (Levels a) (Levels b) (AltLevels a) (AltLevels b)
-alt = iso hither yon
-  where
-    hither levs = AltLevels (NE.fromList . toList $ allLevels levs) (pos levs)
-    yon (AltLevels levs curr) = seek curr $ mkLevels1 levs
-
-instance Eq a => Eq (Levels a) where
-  (==) = (==) `on` view alt
-
-deriving via EqEqProp (Levels a) instance Eq a => EqProp (Levels a)
-
-instance Show a => Show (Levels a) where
-  show = unpack . replace "AltLevels" "Levels" . pack . show . view alt
-
-instance NFData a => NFData (Levels a) where
-  rnf = rnf . view alt
-
-instance ToJSON a => ToJSON (Levels a) where
-  toJSON = toJSON . view alt
-
-instance FromJSON a => FromJSON (Levels a) where
-  parseJSON = fmap (review alt) . parseJSON
-
-instance Arbitrary a => Arbitrary (AltLevels a) where
-  arbitrary = do
-    _levels <- arbitrary
-    _currentLevel <- choose (0, pred . toEnum . length $ _levels)
-    pure AltLevels {..}
-  shrink als = do
-    _levels <- shrink $ als ^. levels
-    _currentLevel <- filter (between 0 $ pred . toEnum . length $ _levels)
-                    $ shrink $ als ^. currentLevel
-    pure AltLevels {..}
-
-
-instance Arbitrary a => Arbitrary (Levels a) where
-  arbitrary = review alt <$> arbitrary
-  shrink = fmap (review alt) . shrink . view alt
-
-instance CoArbitrary a => CoArbitrary (Levels a) where
-  coarbitrary = coarbitrary . view alt
-
-instance Function a => Function (Levels a) where
-  function = functionMap (view alt) (review alt)
diff --git a/users/grfn/xanthous/src/Xanthous/Data/Memo.hs b/users/grfn/xanthous/src/Xanthous/Data/Memo.hs
deleted file mode 100644
index 2b2ee0f96028..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/Memo.hs
+++ /dev/null
@@ -1,98 +0,0 @@
---------------------------------------------------------------------------------
--- | Memoized values
---------------------------------------------------------------------------------
-module Xanthous.Data.Memo
-  ( Memoized(UnMemoized)
-  , memoizeWith
-  , getMemoized
-  , runMemoized
-  , fillWith
-  , fillWithM
-  ) where
---------------------------------------------------------------------------------
-import Xanthous.Prelude
-import Data.Aeson (FromJSON, ToJSON)
-import Test.QuickCheck (Arbitrary (arbitrary), oneof, CoArbitrary, Function)
-import Test.QuickCheck.Checkers (EqProp)
-import Xanthous.Util (EqEqProp(EqEqProp))
-import Control.Monad.State.Class (MonadState)
---------------------------------------------------------------------------------
-
--- | A memoized value, keyed by a key
---
--- If key is different than what is stored here, then val is invalid
-data Memoized key val = Memoized key val | UnMemoized
-  deriving stock (Show, Eq, Generic)
-  deriving anyclass (Hashable, FromJSON, ToJSON, NFData, CoArbitrary, Function)
-  deriving EqProp via EqEqProp (Memoized key val)
-
-instance (Arbitrary k, Arbitrary v) => Arbitrary (Memoized k v) where
-  arbitrary = oneof [ pure UnMemoized
-                    , Memoized <$> arbitrary <*> arbitrary
-                    ]
-
--- | Construct a memoized value with the given key
-memoizeWith :: forall key val. key -> val -> Memoized key val
-memoizeWith = Memoized
-{-# INLINE memoizeWith #-}
-
--- | Retrieve a memoized value providing the key. If the value is unmemoized or
--- the keys do not match, returns Nothing.
---
--- >>> getMemoized 1 (memoizeWith @Int @Int 1 2)
--- Just 2
---
--- >>> getMemoized 2 (memoizeWith @Int @Int 1 2)
--- Nothing
---
--- >>> getMemoized 1 (UnMemoized :: Memoized Int Int)
--- Nothing
-getMemoized :: Eq key => key -> Memoized key val -> Maybe val
-getMemoized key (Memoized key' v)
-  | key == key' = Just v
-  | otherwise = Nothing
-getMemoized _ UnMemoized = Nothing
-{-# INLINE getMemoized #-}
-
--- | Get a memoized value using an applicative action to obtain the key
-runMemoized
-  :: (Eq key, Applicative m)
-  => Memoized key val
-  -> m key
-  -> m (Maybe val)
-runMemoized m mk = getMemoized <$> mk <*> pure m
-
--- | In a monadic state containing a 'MemoState', look up the current memoized
--- target of some lens keyed by k, filling it with v if not present and
--- returning either the new or old value
-fillWith
-  :: forall m s k v.
-    (MonadState s m, Eq k)
-  => Lens' s (Memoized k v)
-  -> k
-  -> v
-  -> m v
-fillWith l k v' = do
-  uses l (getMemoized k) >>= \case
-    Just v -> pure v
-    Nothing -> do
-      l .= memoizeWith k v'
-      pure v'
-
--- | In a monadic state, look up the current memoized target of some lens keyed
--- by k, filling it with the result of some monadic action v if not present and
--- returning either the new or old value
-fillWithM
-  :: forall m s k v.
-    (MonadState s m, Eq k)
-  => Lens' s (Memoized k v)
-  -> k
-  -> m v
-  -> m v
-fillWithM l k mv = do
-  uses l (getMemoized k) >>= \case
-    Just v -> pure v
-    Nothing -> do
-      v' <- mv
-      l .= memoizeWith k v'
-      pure v'
diff --git a/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs b/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs
deleted file mode 100644
index 1b875d448302..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/NestedMap.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE UndecidableInstances  #-}
-{-# LANGUAGE QuantifiedConstraints #-}
-{-# LANGUAGE StandaloneDeriving    #-}
-{-# LANGUAGE PolyKinds             #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.NestedMap
-  ( NestedMapVal(..)
-  , NestedMap(..)
-  , lookup
-  , lookupVal
-  , insert
-
-    -- *
-  , (:->)
-  , BifunctorFunctor'(..)
-  , BifunctorMonad'(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude hiding (lookup, foldMap)
-import qualified Xanthous.Prelude as P
---------------------------------------------------------------------------------
-import           Test.QuickCheck
-import           Data.Aeson
-import           Data.Function (fix)
-import           Data.Foldable (Foldable(..))
-import           Data.List.NonEmpty (NonEmpty(..))
-import qualified Data.List.NonEmpty as NE
---------------------------------------------------------------------------------
-
--- | Natural transformations on bifunctors
-type (:->) p q = forall a b. p a b -> q a b
-infixr 0 :->
-
-class (forall b. Bifunctor b => Bifunctor (t b)) => BifunctorFunctor' t where
-  bifmap' :: (Bifunctor p, Bifunctor q) => (p :-> q) -> t p :-> t q
-
-class BifunctorFunctor' t => BifunctorMonad' t where
-  bireturn' :: (Bifunctor p) => p :-> t p
-
-  bibind' :: (Bifunctor p, Bifunctor q) => (p :-> t q) -> t p :-> t q
-  bibind' f = bijoin' . bifmap' f
-
-  bijoin' :: (Bifunctor p) => t (t p) :-> t p
-  bijoin' = bibind' id
-
-  {-# MINIMAL bireturn', (bibind' | bijoin') #-}
-
---------------------------------------------------------------------------------
-
-data NestedMapVal m k v = Val v | Nested (NestedMap m k v)
-
-deriving stock instance
-  ( forall k' v'. (Show k', Show v') => Show (m k' v')
-  , Show k
-  , Show v
-  ) => Show (NestedMapVal m k v)
-
-deriving stock instance
-  ( forall k' v'. (Eq k', Eq v') => Eq (m k' v')
-  , Eq k
-  , Eq v
-  ) => Eq (NestedMapVal m k v)
-
-instance
-  forall m k v.
-  ( Arbitrary (m k v)
-  , Arbitrary (m k (NestedMapVal m k v))
-  , Arbitrary k
-  , Arbitrary v
-  , IsMap (m k (NestedMapVal m k v))
-  , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-  , ContainerKey (m k (NestedMapVal m k v)) ~ k
-  ) => Arbitrary (NestedMapVal m k v) where
-  arbitrary = sized . fix $ \gen n ->
-    let nst = fmap (NestedMap . mapFromList)
-            . listOf
-            $ (,) <$> arbitrary @k <*> gen (n `div` 2)
-    in if n == 0
-       then Val <$> arbitrary
-       else oneof [ Val <$> arbitrary
-                  , Nested <$> nst]
-  shrink (Val v) = Val <$> shrink v
-  shrink (Nested mkv) = Nested <$> shrink mkv
-
-instance Functor (m k) => Functor (NestedMapVal m k) where
-  fmap f (Val v) = Val $ f v
-  fmap f (Nested m) = Nested $ fmap f m
-
-instance Bifunctor m => Bifunctor (NestedMapVal m) where
-  bimap _ g (Val v) = Val $ g v
-  bimap f g (Nested m) = Nested $ bimap f g m
-
-instance BifunctorFunctor' NestedMapVal where
-  bifmap' _ (Val v) = Val v
-  bifmap' f (Nested m) = Nested $ bifmap' f m
-
-instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v)))
-       => ToJSON (NestedMapVal m k v) where
-  toJSON (Val v) = toJSON v
-  toJSON (Nested m) = toJSON m
-
-instance Foldable (m k) => Foldable (NestedMapVal m k) where
-  foldMap f (Val v) = f v
-  foldMap f (Nested m) = foldMap f m
-
--- _NestedMapVal
---   :: forall m k v m' k' v'.
---     ( IsMap (m k v), IsMap (m' k' v')
---     , IsMap (m [k] v), IsMap (m' [k'] v')
---     , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k'
---     , ContainerKey (m [k] v) ~ [k], ContainerKey (m' [k'] v') ~ [k']
---     , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v'
---     , MapValue (m [k] v) ~ v, MapValue (m' [k'] v') ~ v'
---     )
---   => Iso (NestedMapVal m k v)
---         (NestedMapVal m' k' v')
---         (m [k] v)
---         (m' [k'] v')
--- _NestedMapVal = iso hither yon
---   where
---     hither :: NestedMapVal m k v -> m [k] v
---     hither (Val v) = singletonMap [] v
---     hither (Nested m) = bimap _ _ $ m ^. _NestedMap
---     yon = _
-
---------------------------------------------------------------------------------
-
-newtype NestedMap m k v = NestedMap (m k (NestedMapVal m k v))
-
-deriving stock instance
-  ( forall k' v'. (Eq k', Eq v') => Eq (m k' v')
-  , Eq k
-  , Eq v
-  ) => Eq (NestedMap m k v)
-
-deriving stock instance
-  ( forall k' v'. (Show k', Show v') => Show (m k' v')
-  , Show k
-  , Show v
-  ) => Show (NestedMap m k v)
-
-instance Arbitrary (m k (NestedMapVal m k v))
-       => Arbitrary (NestedMap m k v) where
-  arbitrary = NestedMap <$> arbitrary
-  shrink (NestedMap m) = NestedMap <$> shrink m
-
-instance Functor (m k) => Functor (NestedMap m k) where
-  fmap f (NestedMap m) = NestedMap $ fmap (fmap f) m
-
-instance Bifunctor m => Bifunctor (NestedMap m) where
-  bimap f g (NestedMap m) = NestedMap $ bimap f (bimap f g) m
-
-instance BifunctorFunctor' NestedMap where
-  bifmap' f (NestedMap m) = NestedMap . f $ bimap id (bifmap' f) m
-
-instance (ToJSONKey k, ToJSON v, ToJSON (m k (NestedMapVal m k v)))
-       => ToJSON (NestedMap m k v) where
-  toJSON (NestedMap m) = toJSON m
-
-instance Foldable (m k) => Foldable (NestedMap m k) where
-  foldMap f (NestedMap m) = foldMap (foldMap f) m
-
---------------------------------------------------------------------------------
-
-lookup
-  :: ( IsMap (m k (NestedMapVal m k v))
-    , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-    , ContainerKey (m k (NestedMapVal m k v)) ~ k
-    )
-  => NonEmpty k
-  -> NestedMap m k v
-  -> Maybe (NestedMapVal m k v)
-lookup (p :| []) (NestedMap vs) = P.lookup p vs
-lookup (p :| (p₁ : ps)) (NestedMap vs) = P.lookup p vs >>= \case
-  (Val _) -> Nothing
-  (Nested vs') -> lookup (p₁ :| ps) vs'
-
-lookupVal
-  :: ( IsMap (m k (NestedMapVal m k v))
-    , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-    , ContainerKey (m k (NestedMapVal m k v)) ~ k
-    )
-  => NonEmpty k
-  -> NestedMap m k v
-  -> Maybe v
-lookupVal ks m
-  | Just (Val v) <- lookup ks m = Just v
-  | otherwise                  = Nothing
-
-insert
-  :: ( IsMap (m k (NestedMapVal m k v))
-    , MapValue (m k (NestedMapVal m k v)) ~ (NestedMapVal m k v)
-    , ContainerKey (m k (NestedMapVal m k v)) ~ k
-    )
-  => NonEmpty k
-  -> v
-  -> NestedMap m k v
-  -> NestedMap m k v
-insert (k :| []) v (NestedMap m) = NestedMap $ P.insertMap k (Val v) m
-insert (k₁ :| (k₂ : ks)) v (NestedMap m) = NestedMap $ alterMap upd k₁ m
-  where
-    upd (Just (Nested nm)) = Just . Nested $ insert (k₂ :| ks) v nm
-    upd _ = Just $
-      let (kΩ :| ks') = NE.reverse (k₂ :| ks)
-      in P.foldl'
-         (\m' k -> Nested . NestedMap . singletonMap k $ m')
-         (Nested . NestedMap . singletonMap kΩ $ Val v)
-         ks'
-
--- _NestedMap
---   :: ( IsMap (m k v), IsMap (m' k' v')
---     , IsMap (m (NonEmpty k) v), IsMap (m' (NonEmpty k') v')
---     , ContainerKey (m k v) ~ k, ContainerKey (m' k' v') ~ k'
---     , ContainerKey (m (NonEmpty k) v) ~ (NonEmpty k)
---     , ContainerKey (m' (NonEmpty k') v') ~ (NonEmpty k')
---     , MapValue (m k v) ~ v, MapValue (m' k' v') ~ v'
---     , MapValue (m (NonEmpty k) v) ~ v, MapValue (m' (NonEmpty k') v') ~ v'
---     )
---   => Iso (NestedMap m k v)
---         (NestedMap m' k' v')
---         (m (NonEmpty k) v)
---         (m' (NonEmpty k') v')
--- _NestedMap = iso undefined yon
---   where
---     hither (NestedMap m) = undefined . mapToList $ m
---     yon mkv = undefined
diff --git a/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs b/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs
deleted file mode 100644
index 2e6d48062a45..000000000000
--- a/users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs
+++ /dev/null
@@ -1,100 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE StandaloneDeriving #-}
-{-# LANGUAGE DeriveTraversable #-}
-{-# LANGUAGE TemplateHaskell #-}
---------------------------------------------------------------------------------
-module Xanthous.Data.VectorBag
-  (VectorBag(..)
-  ) where
---------------------------------------------------------------------------------
-import           Xanthous.Prelude
-import           Data.Aeson
-import qualified Data.Vector as V
-import           Test.QuickCheck
-import           Test.QuickCheck.Instances.Vector ()
---------------------------------------------------------------------------------
-
--- | Acts exactly like a Vector, except ignores order when testing for equality
-newtype VectorBag a = VectorBag (Vector a)
-  deriving stock
-    ( Traversable
-    , Generic
-    )
-  deriving newtype
-    ( Show
-    , Read
-    , Foldable
-    , FromJSON
-    , FromJSON1
-    , ToJSON
-    , Reversing
-    , Applicative
-    , Functor
-    , Monad
-    , Monoid
-    , Semigroup
-    , Arbitrary
-    , CoArbitrary
-    , Filterable
-    )
-makeWrapped ''VectorBag
-
-instance Function a => Function (VectorBag a) where
-  function = functionMap (\(VectorBag v) -> v) VectorBag
-
-type instance Element (VectorBag a) = a
-deriving via (Vector a) instance MonoFoldable (VectorBag a)
-deriving via (Vector a) instance GrowingAppend (VectorBag a)
-deriving via (Vector a) instance SemiSequence (VectorBag a)
-deriving via (Vector a) instance MonoPointed (VectorBag a)
-deriving via (Vector a) instance MonoFunctor (VectorBag a)
-
-instance Cons (VectorBag a) (VectorBag b) a b where
-  _Cons = prism (\(x, VectorBag xs) -> VectorBag $ x <| xs) $ \(VectorBag v) ->
-    if V.null v
-    then Left (VectorBag mempty)
-    else Right (V.unsafeHead v, VectorBag $ V.unsafeTail v)
-
-instance AsEmpty (VectorBag a) where
-  _Empty = prism' (const $ VectorBag Empty) $ \case
-    (VectorBag Empty) -> Just ()
-    _ -> Nothing
-
-instance Witherable VectorBag where
-  wither f (VectorBag v) = VectorBag <$> wither f v
-  witherM f (VectorBag v) = VectorBag <$> witherM f v
-  filterA p (VectorBag v) = VectorBag <$> filterA p v
-
-{-
-    TODO:
-    , Ixed
-    , FoldableWithIndex
-    , FunctorWithIndex
-    , TraversableWithIndex
-    , Snoc
-    , Each
--}
-
-instance Ord a => Eq (VectorBag a) where
-  (==) = (==) `on` (view _Wrapped . sort)
-
-instance Ord a => Ord (VectorBag a) where
-  compare = compare  `on` (view _Wrapped . sort)
-
-instance MonoTraversable (VectorBag a) where
-  otraverse f (VectorBag v) = VectorBag <$> otraverse f v
-
-instance IsSequence (VectorBag a) where
-  fromList = VectorBag . fromList
-  break prd (VectorBag v) = bimap VectorBag VectorBag $ break prd v
-  span prd (VectorBag v) = bimap VectorBag VectorBag $ span prd v
-  dropWhile prd (VectorBag v) = VectorBag $ dropWhile prd v
-  takeWhile prd (VectorBag v) = VectorBag $ takeWhile prd v
-  splitAt idx (VectorBag v) = bimap VectorBag VectorBag $ splitAt idx v
-  unsafeSplitAt idx (VectorBag v) =
-    bimap VectorBag VectorBag $ unsafeSplitAt idx v
-  take n (VectorBag v) = VectorBag $ take n v
-  unsafeTake n (VectorBag v) = VectorBag $ unsafeTake n v
-  drop n (VectorBag v) = VectorBag $ drop n v
-  unsafeDrop n (VectorBag v) = VectorBag $ unsafeDrop n v
-  partition p (VectorBag v) = bimap VectorBag VectorBag $ partition p v
generated by cgit-pink 1.4.1 (git 2.44.2) at 2024-12-19T07·19+0000