From 6c7e14d2dcd3a3b124dc035e8feb8e79534cd66a Mon Sep 17 00:00:00 2001
From: Griffin Smith <grfn@gws.fyi>
Date: Sun, 28 Jun 2020 16:43:20 -0400
Subject: feat(xan): Use Witherable in the prelude

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>
---
 users/glittershark/xanthous/src/Xanthous/Data.hs              |  5 ++++-
 users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs    |  6 ++++++
 users/glittershark/xanthous/src/Xanthous/Messages/Template.hs |  4 ++--
 users/glittershark/xanthous/src/Xanthous/Prelude.hs           | 11 ++++++++++-
 4 files changed, 22 insertions(+), 4 deletions(-)

(limited to 'users/glittershark/xanthous/src')

diff --git a/users/glittershark/xanthous/src/Xanthous/Data.hs b/users/glittershark/xanthous/src/Xanthous/Data.hs
index 3cb74bdca9fd..67173cc89646 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 bd9af369e01c..2e6d48062a45 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 0f47729d6871..2998db7f7bf9 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 9a4ca0149f1a..b4f13332467e 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 ($!)
-- 
cgit 1.4.1