diff options
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 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 ($!) |