about summary refs log tree commit diff
path: root/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs
diff options
context:
space:
mode:
Diffstat (limited to 'third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs')
-rw-r--r--third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs350
1 files changed, 0 insertions, 350 deletions
diff --git a/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs b/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs
deleted file mode 100644
index 86a4f2c324..0000000000
--- a/third_party/bazel/rules_haskell/examples/vector/tests/Utilities.hs
+++ /dev/null
@@ -1,350 +0,0 @@
-{-# LANGUAGE FlexibleInstances, GADTs #-}
-module Utilities where
-
-import Test.QuickCheck
-
-import qualified Data.Vector as DV
-import qualified Data.Vector.Generic as DVG
-import qualified Data.Vector.Primitive as DVP
-import qualified Data.Vector.Storable as DVS
-import qualified Data.Vector.Unboxed as DVU
-import qualified Data.Vector.Fusion.Bundle as S
-
-import Control.Monad (foldM, foldM_, zipWithM, zipWithM_)
-import Control.Monad.Trans.Writer
-import Data.Function (on)
-import Data.Functor.Identity
-import Data.List ( sortBy )
-import Data.Monoid
-import Data.Maybe (catMaybes)
-
-instance Show a => Show (S.Bundle v a) where
-    show s = "Data.Vector.Fusion.Bundle.fromList " ++ show (S.toList s)
-
-
-instance Arbitrary a => Arbitrary (DV.Vector a) where
-    arbitrary = fmap DV.fromList arbitrary
-
-instance CoArbitrary a => CoArbitrary (DV.Vector a) where
-    coarbitrary = coarbitrary . DV.toList
-
-instance (Arbitrary a, DVP.Prim a) => Arbitrary (DVP.Vector a) where
-    arbitrary = fmap DVP.fromList arbitrary
-
-instance (CoArbitrary a, DVP.Prim a) => CoArbitrary (DVP.Vector a) where
-    coarbitrary = coarbitrary . DVP.toList
-
-instance (Arbitrary a, DVS.Storable a) => Arbitrary (DVS.Vector a) where
-    arbitrary = fmap DVS.fromList arbitrary
-
-instance (CoArbitrary a, DVS.Storable a) => CoArbitrary (DVS.Vector a) where
-    coarbitrary = coarbitrary . DVS.toList
-
-instance (Arbitrary a, DVU.Unbox a) => Arbitrary (DVU.Vector a) where
-    arbitrary = fmap DVU.fromList arbitrary
-
-instance (CoArbitrary a, DVU.Unbox a) => CoArbitrary (DVU.Vector a) where
-    coarbitrary = coarbitrary . DVU.toList
-
-instance Arbitrary a => Arbitrary (S.Bundle v a) where
-    arbitrary = fmap S.fromList arbitrary
-
-instance CoArbitrary a => CoArbitrary (S.Bundle v a) where
-    coarbitrary = coarbitrary . S.toList
-
-instance (Arbitrary a, Arbitrary b) => Arbitrary (Writer a b) where
-    arbitrary = do b <- arbitrary
-                   a <- arbitrary
-                   return $ writer (b,a)
-
-instance CoArbitrary a => CoArbitrary (Writer a ()) where
-    coarbitrary = coarbitrary . runWriter
-
-class (Testable (EqTest a), Conclusion (EqTest a)) => TestData a where
-  type Model a
-  model :: a -> Model a
-  unmodel :: Model a -> a
-
-  type EqTest a
-  equal :: a -> a -> EqTest a
-
-instance Eq a => TestData (S.Bundle v a) where
-  type Model (S.Bundle v a) = [a]
-  model = S.toList
-  unmodel = S.fromList
-
-  type EqTest (S.Bundle v a) = Property
-  equal x y = property (x == y)
-
-instance Eq a => TestData (DV.Vector a) where
-  type Model (DV.Vector a) = [a]
-  model = DV.toList
-  unmodel = DV.fromList
-
-  type EqTest (DV.Vector a) = Property
-  equal x y = property (x == y)
-
-instance (Eq a, DVP.Prim a) => TestData (DVP.Vector a) where
-  type Model (DVP.Vector a) = [a]
-  model = DVP.toList
-  unmodel = DVP.fromList
-
-  type EqTest (DVP.Vector a) = Property
-  equal x y = property (x == y)
-
-instance (Eq a, DVS.Storable a) => TestData (DVS.Vector a) where
-  type Model (DVS.Vector a) = [a]
-  model = DVS.toList
-  unmodel = DVS.fromList
-
-  type EqTest (DVS.Vector a) = Property
-  equal x y = property (x == y)
-
-instance (Eq a, DVU.Unbox a) => TestData (DVU.Vector a) where
-  type Model (DVU.Vector a) = [a]
-  model = DVU.toList
-  unmodel = DVU.fromList
-
-  type EqTest (DVU.Vector a) = Property
-  equal x y = property (x == y)
-
-#define id_TestData(ty) \
-instance TestData ty where { \
-  type Model ty = ty;        \
-  model = id;                \
-  unmodel = id;              \
-                             \
-  type EqTest ty = Property; \
-  equal x y = property (x == y) }
-
-id_TestData(())
-id_TestData(Bool)
-id_TestData(Int)
-id_TestData(Float)
-id_TestData(Double)
-id_TestData(Ordering)
-
--- Functorish models
--- All of these need UndecidableInstances although they are actually well founded. Oh well.
-instance (Eq a, TestData a) => TestData (Maybe a) where
-  type Model (Maybe a) = Maybe (Model a)
-  model = fmap model
-  unmodel = fmap unmodel
-
-  type EqTest (Maybe a) = Property
-  equal x y = property (x == y)
-
-instance (Eq a, TestData a) => TestData [a] where
-  type Model [a] = [Model a]
-  model = fmap model
-  unmodel = fmap unmodel
-
-  type EqTest [a] = Property
-  equal x y = property (x == y)
-
-instance (Eq a, TestData a) => TestData (Identity a) where
-  type Model (Identity a) = Identity (Model a)
-  model = fmap model
-  unmodel = fmap unmodel
-
-  type EqTest (Identity a) = Property
-  equal = (property .) . on (==) runIdentity
-
-instance (Eq a, TestData a, Eq b, TestData b, Monoid a) => TestData (Writer a b) where
-  type Model (Writer a b) = Writer (Model a) (Model b)
-  model = mapWriter model
-  unmodel = mapWriter unmodel
-
-  type EqTest (Writer a b) = Property
-  equal = (property .) . on (==) runWriter
-
-instance (Eq a, Eq b, TestData a, TestData b) => TestData (a,b) where
-  type Model (a,b) = (Model a, Model b)
-  model (a,b) = (model a, model b)
-  unmodel (a,b) = (unmodel a, unmodel b)
-
-  type EqTest (a,b) = Property
-  equal x y = property (x == y)
-
-instance (Eq a, Eq b, Eq c, TestData a, TestData b, TestData c) => TestData (a,b,c) where
-  type Model (a,b,c) = (Model a, Model b, Model c)
-  model (a,b,c) = (model a, model b, model c)
-  unmodel (a,b,c) = (unmodel a, unmodel b, unmodel c)
-
-  type EqTest (a,b,c) = Property
-  equal x y = property (x == y)
-
-instance (Arbitrary a, Show a, TestData a, TestData b) => TestData (a -> b) where
-  type Model (a -> b) = Model a -> Model b
-  model f = model . f . unmodel
-  unmodel f = unmodel . f . model
-
-  type EqTest (a -> b) = a -> EqTest b
-  equal f g x = equal (f x) (g x)
-
-newtype P a = P { unP :: EqTest a }
-
-instance TestData a => Testable (P a) where
-  property (P a) = property a
-
-infix 4 `eq`
-eq :: TestData a => a -> Model a -> P a
-eq x y = P (equal x (unmodel y))
-
-class Conclusion p where
-  type Predicate p
-
-  predicate :: Predicate p -> p -> p
-
-instance Conclusion Property where
-  type Predicate Property = Bool
-
-  predicate = (==>)
-
-instance Conclusion p => Conclusion (a -> p) where
-  type Predicate (a -> p) = a -> Predicate p
-
-  predicate f p = \x -> predicate (f x) (p x)
-
-infixr 0 ===>
-(===>) :: TestData a => Predicate (EqTest a) -> P a -> P a
-p ===> P a = P (predicate p a)
-
-notNull2 _ xs = not $ DVG.null xs
-notNullS2 _ s = not $ S.null s
-
--- Generators
-index_value_pairs :: Arbitrary a => Int -> Gen [(Int,a)]
-index_value_pairs 0 = return []
-index_value_pairs m = sized $ \n ->
-  do
-    len <- choose (0,n)
-    is <- sequence [choose (0,m-1) | i <- [1..len]]
-    xs <- vector len
-    return $ zip is xs
-
-indices :: Int -> Gen [Int]
-indices 0 = return []
-indices m = sized $ \n ->
-  do
-    len <- choose (0,n)
-    sequence [choose (0,m-1) | i <- [1..len]]
-
-
--- Additional list functions
-singleton x = [x]
-snoc xs x = xs ++ [x]
-generate n f = [f i | i <- [0 .. n-1]]
-slice i n xs = take n (drop i xs)
-backpermute xs is = map (xs!!) is
-prescanl f z = init . scanl f z
-postscanl f z = tail . scanl f z
-prescanr f z = tail . scanr f z
-postscanr f z = init . scanr f z
-
-accum :: (a -> b -> a) -> [a] -> [(Int,b)] -> [a]
-accum f xs ps = go xs ps' 0
-  where
-    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
-
-    go (x:xs) ((i,y) : ps) j
-      | i == j     = go (f x y : xs) ps j
-    go (x:xs) ps j = x : go xs ps (j+1)
-    go [] _ _      = []
-
-(//) :: [a] -> [(Int, a)] -> [a]
-xs // ps = go xs ps' 0
-  where
-    ps' = sortBy (\p q -> compare (fst p) (fst q)) ps
-
-    go (x:xs) ((i,y) : ps) j
-      | i == j     = go (y:xs) ps j
-    go (x:xs) ps j = x : go xs ps (j+1)
-    go [] _ _      = []
-
-
-withIndexFirst m f = m (uncurry f) . zip [0..]
-
-imap :: (Int -> a -> a) -> [a] -> [a]
-imap = withIndexFirst map
-
-imapM :: Monad m => (Int -> a -> m a) -> [a] -> m [a]
-imapM = withIndexFirst mapM
-
-imapM_ :: Monad m => (Int -> a -> m b) -> [a] -> m ()
-imapM_ = withIndexFirst mapM_
-
-izipWith :: (Int -> a -> a -> a) -> [a] -> [a] -> [a]
-izipWith = withIndexFirst zipWith
-
-izipWithM :: Monad m => (Int -> a -> a -> m a) -> [a] -> [a] -> m [a]
-izipWithM = withIndexFirst zipWithM
-
-izipWithM_ :: Monad m => (Int -> a -> a -> m b) -> [a] -> [a] -> m ()
-izipWithM_ = withIndexFirst zipWithM_
-
-izipWith3 :: (Int -> a -> a -> a -> a) -> [a] -> [a] -> [a] -> [a]
-izipWith3 = withIndexFirst zipWith3
-
-ifilter :: (Int -> a -> Bool) -> [a] -> [a]
-ifilter f = map snd . withIndexFirst filter f
-
-mapMaybe :: (a -> Maybe b) -> [a] -> [b]
-mapMaybe f = catMaybes . map f
-
-imapMaybe :: (Int -> a -> Maybe b) -> [a] -> [b]
-imapMaybe f = catMaybes . withIndexFirst map f
-
-indexedLeftFold fld f z = fld (uncurry . f) z . zip [0..]
-
-ifoldl :: (a -> Int -> a -> a) -> a -> [a] -> a
-ifoldl = indexedLeftFold foldl
-
-iscanl :: (Int -> a -> b -> a) -> a -> [b] -> [a]
-iscanl f z = scanl (\a (i, b) -> f i a b) z . zip [0..]
-
-iscanr :: (Int -> a -> b -> b) -> b -> [a] -> [b]
-iscanr f z = scanr (uncurry f) z . zip [0..]
-
-ifoldr :: (Int -> a -> b -> b) -> b -> [a] -> b
-ifoldr f z = foldr (uncurry f) z . zip [0..]
-
-ifoldM :: Monad m => (a -> Int -> a -> m a) -> a -> [a] -> m a
-ifoldM = indexedLeftFold foldM
-
-ifoldM_ :: Monad m => (b -> Int -> a -> m b) -> b -> [a] -> m ()
-ifoldM_ = indexedLeftFold foldM_
-
-minIndex :: Ord a => [a] -> Int
-minIndex = fst . foldr1 imin . zip [0..]
-  where
-    imin (i,x) (j,y) | x <= y    = (i,x)
-                     | otherwise = (j,y)
-
-maxIndex :: Ord a => [a] -> Int
-maxIndex = fst . foldr1 imax . zip [0..]
-  where
-    imax (i,x) (j,y) | x >= y    = (i,x)
-                     | otherwise = (j,y)
-
-iterateNM :: Monad m => Int -> (a -> m a) -> a -> m [a]
-iterateNM n f x
-    | n <= 0    = return []
-    | n == 1    = return [x]
-    | otherwise =  do x' <- f x
-                      xs <- iterateNM (n-1) f x'
-                      return (x : xs)
-
-unfoldrM :: Monad m => (b -> m (Maybe (a,b))) -> b -> m [a]
-unfoldrM step b0 = do
-    r <- step b0
-    case r of
-      Nothing    -> return []
-      Just (a,b) -> do as <- unfoldrM step b
-                       return (a : as)
-
-
-limitUnfolds f (theirs, ours)
-    | ours >= 0
-    , Just (out, theirs') <- f theirs = Just (out, (theirs', ours - 1))
-    | otherwise                       = Nothing