diff options
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs')
-rw-r--r-- | users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs | 100 |
1 files changed, 0 insertions, 100 deletions
diff --git a/users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs b/users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs deleted file mode 100644 index 2e6d48062a45..000000000000 --- a/users/glittershark/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 |