diff options
author | Aspen Smith <grfn@gws.fyi> | 2024-02-12T03·00-0500 |
---|---|---|
committer | clbot <clbot@tvl.fyi> | 2024-02-14T19·37+0000 |
commit | 82ecd61f5c699cf3af6c4eadf47a1c52b1d696c6 (patch) | |
tree | 429c5e078528000591742ec3211bc768ae913a78 /users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs | |
parent | 0ba476a4266015f278f18d74094299de74a5a111 (diff) |
chore(users): grfn -> aspen r/7511
Change-Id: I6c6847fac56f0a9a1a2209792e00a3aec5e672b9 Reviewed-on: https://cl.tvl.fyi/c/depot/+/10809 Autosubmit: aspen <root@gws.fyi> Reviewed-by: sterni <sternenseemann@systemli.org> Tested-by: BuildkiteCI Reviewed-by: lukegb <lukegb@tvl.fyi>
Diffstat (limited to 'users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs')
-rw-r--r-- | users/grfn/xanthous/src/Xanthous/Data/VectorBag.hs | 100 |
1 files changed, 0 insertions, 100 deletions
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 |