diff options
author | Griffin Smith <grfn@gws.fyi> | 2020-06-28T20·43-0400 |
---|---|---|
committer | glittershark <grfn@gws.fyi> | 2020-06-28T23·38+0000 |
commit | 6c7e14d2dcd3a3b124dc035e8feb8e79534cd66a (patch) | |
tree | f551473902e566c03746a8dd2014634a48a2c434 /users/glittershark/xanthous/src/Xanthous | |
parent | 20bc4aa10dffcbcc42139afafa10aa5f7a5090bb (diff) |
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>
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous')
4 files changed, 22 insertions, 4 deletions
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 ($!) |