feat(xan): Use Witherable in the prelude r/1110

Install the witherable library, expose it in the prelude, and update all
call sites that are broken by that change.

This is a really nice library, and basically the ideal abstraction layer
for what it does.

Change-Id: I640e099318c1ecce0ad483bc336c379698bdab88
Reviewed-on: https://cl.tvl.fyi/c/depot/+/725
Reviewed-by: glittershark <grfn@gws.fyi>

7 files changed, 30 insertions, 6 deletions

diff --git a/users/glittershark/xanthous/package.yaml b/users/glittershark/xanthous/package.yaml
index 5f43171e38..5321b1fd3c 100644
--- a/users/glittershark/xanthous/package.yaml
+++ b/users/glittershark/xanthous/package.yaml
@@ -71,6 +71,7 @@ dependencies:
 - text-zipper
 - vector
 - vty
+- witherable
 - yaml
 - zlib
 
diff --git a/users/glittershark/xanthous/src/Xanthous/Data.hs b/users/glittershark/xanthous/src/Xanthous/Data.hs
index 3cb74bdca9..67173cc896 100644
--- a/users/glittershark/xanthous/src/Xanthous/Data.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Data.hs
@@ -387,8 +387,11 @@ data Neighbors a = Neighbors
   , _bottomRight :: a
   }
   deriving stock (Show, Eq, Ord, Functor, Foldable, Traversable, Generic)
-  deriving anyclass (NFData, CoArbitrary, Function)
+  deriving anyclass (NFData, CoArbitrary, Function, MonoFoldable)
   deriving Arbitrary via GenericArbitrary (Neighbors a)
+
+type instance Element (Neighbors a) = a
+
 makeFieldsNoPrefix ''Neighbors
 
 instance Applicative Neighbors where
diff --git a/users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs b/users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs
index bd9af369e0..2e6d48062a 100644
--- a/users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs
@@ -35,6 +35,7 @@ newtype VectorBag a = VectorBag (Vector a)
     , Semigroup
     , Arbitrary
     , CoArbitrary
+    , Filterable
     )
 makeWrapped ''VectorBag
 
@@ -59,6 +60,11 @@ instance AsEmpty (VectorBag a) where
     (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
diff --git a/users/glittershark/xanthous/src/Xanthous/Messages/Template.hs b/users/glittershark/xanthous/src/Xanthous/Messages/Template.hs
index 0f47729d68..2998db7f7b 100644
--- a/users/glittershark/xanthous/src/Xanthous/Messages/Template.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Messages/Template.hs
@@ -28,7 +28,7 @@ module Xanthous.Messages.Template
 where
 --------------------------------------------------------------------------------
 import           Xanthous.Prelude hiding
-                 (many, concat, try, elements, some, parts)
+                 (many, concat, try, elements, some, parts, Filter)
 --------------------------------------------------------------------------------
 import           Test.QuickCheck hiding (label)
 import           Test.QuickCheck.Instances.Text ()
@@ -113,7 +113,7 @@ instance Eq Template where
 
 instance Arbitrary Template where
   arbitrary = sized . fix $ \gen n ->
-    let leaves = [ Literal . filter (`notElem` ['\\', '{']) <$> arbitrary
+    let leaves = [ Literal . pack . filter (`notElem` ['\\', '{']) <$> arbitrary
                  , Subst <$> arbitrary
                  ]
         subtree = gen $ n `div` 2
diff --git a/users/glittershark/xanthous/src/Xanthous/Prelude.hs b/users/glittershark/xanthous/src/Xanthous/Prelude.hs
index 9a4ca0149f..b4f1333246 100644
--- a/users/glittershark/xanthous/src/Xanthous/Prelude.hs
+++ b/users/glittershark/xanthous/src/Xanthous/Prelude.hs
@@ -7,7 +7,9 @@ module Xanthous.Prelude
   , module Control.Lens
   , module Data.Void
   , module Control.Comonad
+  , module Data.Witherable
 
+  , (&!)
 
     -- * Classy-Prelude addons
   , ninsertSet
@@ -16,12 +18,15 @@ module Xanthous.Prelude
   ) where
 --------------------------------------------------------------------------------
 import ClassyPrelude hiding
-  (return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say)
+  ( return, (<|), unsnoc, uncons, cons, snoc, index, (<.>), Index, say
+  , catMaybes, filter, mapMaybe, hashNub, ordNub
+  )
 import Data.Kind
 import GHC.TypeLits hiding (Text)
 import Control.Lens hiding (levels, Level)
 import Data.Void
 import Control.Comonad
+import Data.Witherable
 --------------------------------------------------------------------------------
 
 ninsertSet
@@ -34,3 +39,7 @@ ndeleteSet x = deleteSet x . toNullable
 
 toVector :: (MonoFoldable (f a), Element (f a) ~ a) => f a -> Vector a
 toVector = fromList . toList
+
+infixl 1 &!
+(&!) :: a -> (a -> b) -> b
+(&!) = flip ($!)
diff --git a/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs b/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
index 8ea5186c50..2a3873c3b0 100644
--- a/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
+++ b/users/glittershark/xanthous/test/Xanthous/Messages/TemplateSpec.hs
@@ -62,7 +62,7 @@ test = testGroup "Xanthous.Messages.Template"
     ]
   ]
   where
-    genLiteral = filter (`notElem` ['\\', '{']) <$> arbitrary
+    genLiteral = pack . filter (`notElem` ['\\', '{']) <$> arbitrary
     parseCase name input expected =
       testCase name $ testParse template input @?= Right expected
     testParse p = over _Left errorBundlePretty . runParser p "<test>"
diff --git a/users/glittershark/xanthous/xanthous.cabal b/users/glittershark/xanthous/xanthous.cabal
index 6d0b7b1093..63649a89a8 100644
--- a/users/glittershark/xanthous/xanthous.cabal
+++ b/users/glittershark/xanthous/xanthous.cabal
@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 0486cac7957fae1f9badffdd082f0c5eb5910eb8c066569123b0f57bc6fa0d8b
+-- hash: 88019942f93977e08b513ce6991401694c431b7b2b7b1b5d2afccb3f0afb26ed
 
 name:           xanthous
 version:        0.1.0.0
@@ -53,6 +53,7 @@ library
       Xanthous.Entities.Entities
       Xanthous.Entities.Environment
       Xanthous.Entities.Item
+      Xanthous.Entities.Marker
       Xanthous.Entities.Raws
       Xanthous.Entities.RawTypes
       Xanthous.Game
@@ -143,6 +144,7 @@ library
     , tomland
     , vector
     , vty
+    , witherable
     , yaml
     , zlib
   default-language: Haskell2010
@@ -174,6 +176,7 @@ executable xanthous
       Xanthous.Entities.Entities
       Xanthous.Entities.Environment
       Xanthous.Entities.Item
+      Xanthous.Entities.Marker
       Xanthous.Entities.Raws
       Xanthous.Entities.RawTypes
       Xanthous.Game
@@ -263,6 +266,7 @@ executable xanthous
     , tomland
     , vector
     , vty
+    , witherable
     , xanthous
     , yaml
     , zlib
@@ -355,6 +359,7 @@ test-suite test
     , tomland
     , vector
     , vty
+    , witherable
     , xanthous
     , yaml
     , zlib