about summary refs log tree commit diff
path: root/users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs
diff options
context:
space:
mode:
Diffstat (limited to 'users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs')
-rw-r--r--users/glittershark/xanthous/src/Xanthous/Data/VectorBag.hs100
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