filtrable-0.1.6.0/ 0000755 0000000 0000000 00000000000 07346545000 012011 5 ustar 00 0000000 0000000 filtrable-0.1.6.0/Data/ 0000755 0000000 0000000 00000000000 07346545000 012662 5 ustar 00 0000000 0000000 filtrable-0.1.6.0/Data/Filtrable.hs 0000644 0000000 0000000 00000013376 07346545000 015134 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
-- | See 'Filtrable'.
module Data.Filtrable
( Filtrable (..)
, (<$?>), (<*?>)
, nub, nubBy, nubOrd, nubOrdBy
) where
import Prelude hiding (filter)
import Control.Applicative
import Control.Applicative.Backwards
import Control.Monad
import qualified Control.Monad.Trans.State as M
import Data.Bool (bool)
import Data.Functor.Compose
import Data.Functor.Product
import Data.Functor.Reverse
import Data.Functor.Sum
import Data.Proxy
import Data.Traversable
#ifdef MIN_VERSION_containers
import Data.IntMap (IntMap)
import qualified Data.IntMap as IntMap
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Sequence (Seq)
import qualified Data.Sequence as Seq
#endif
import qualified Data.Set.Private as Set
-- | Class of filtrable containers, i.e. containers we can map over while selectively dropping elements.
--
-- Laws:
--
-- * @'mapMaybe' 'Just' = id@
--
-- * @'mapMaybe' f = 'catMaybes' ∘ 'fmap' f@
--
-- * @'catMaybes' = 'mapMaybe' id@
--
-- * @'filter' f = 'mapMaybe' (\\ x -> 'bool' 'Nothing' ('Just' x) (f x))@
--
-- * @'mapMaybe' g . 'mapMaybe' f = 'mapMaybe' (g '<=<' f)@
--
-- Laws if @'Foldable' f@:
--
-- * @'foldMap' g . 'filter' f = 'foldMap' (\\ x -> 'bool' 'mempty' (g x) (f x))@
class Functor f => Filtrable f where
{-# MINIMAL mapMaybe | catMaybes #-}
-- | Map the container with the given function, dropping the elements for which it returns 'Nothing'.
mapMaybe :: (a -> Maybe b) -> f a -> f b
mapMaybe f = catMaybes . fmap f
-- | @'catMaybes' = 'mapMaybe' 'id'@
catMaybes :: f (Maybe a) -> f a
catMaybes = mapMaybe id
-- | Drop the elements for which the given predicate is 'False'.
filter :: (a -> Bool) -> f a -> f a
filter f = mapMaybe ((<$) <*> guard . f)
-- | Traverse the container with the given function, dropping the elements for which it returns 'Nothing'.
mapMaybeA :: (Traversable f, Applicative p) => (a -> p (Maybe b)) -> f a -> p (f b)
mapMaybeA f xs = catMaybes <$> traverse f xs
-- | Drop the elements for which the given predicate is 'False'.
filterA :: (Traversable f, Applicative p) => (a -> p Bool) -> f a -> p (f a)
filterA f = mapMaybeA (\ x -> (x <$) . guard <$> f x)
-- | Map the container with the given function, collecting the 'Left's and the 'Right's separately.
mapEither :: (a -> Either b c) -> f a -> (f b, f c)
mapEither f = (,) <$> mapMaybe (either Just (pure Nothing) . f)
<*> mapMaybe (either (pure Nothing) Just . f)
-- | Traverse the container with the given function, collecting the 'Left's and the 'Right's separately.
mapEitherA :: (Traversable f, Applicative p) => (a -> p (Either b c)) -> f a -> p (f b, f c)
mapEitherA f = liftA2 (,) <$> mapMaybeA (fmap (Just `either` pure Nothing) . f)
<*> mapMaybeA (fmap (pure Nothing `either` Just) . f)
-- | @'partitionEithers' = 'mapEither' 'id'@
partitionEithers :: f (Either a b) -> (f a, f b)
partitionEithers = mapEither id
instance Filtrable [] where
mapMaybe f = foldr (maybe id (:) . f) []
mapMaybeA _ [] = pure []
mapMaybeA f (x:xs) = maybe id (:) <$> f x <*> mapMaybeA f xs
instance Filtrable Maybe where
mapMaybe = (=<<)
catMaybes = join
instance Filtrable Proxy where
mapMaybe _ Proxy = Proxy
instance Filtrable (Const a) where
mapMaybe _ (Const x) = Const x
instance (Filtrable f, Filtrable g) => Filtrable (Product f g) where
mapMaybe f (Pair as bs) = Pair (mapMaybe f as) (mapMaybe f bs)
instance (Filtrable f, Filtrable g) => Filtrable (Sum f g) where
mapMaybe f = \ case
InL as -> InL (mapMaybe f as)
InR bs -> InR (mapMaybe f bs)
instance (Functor f, Filtrable g) => Filtrable (Compose f g) where
mapMaybe f = Compose . (fmap . mapMaybe) f . getCompose
instance Filtrable f => Filtrable (Backwards f) where
mapMaybe f = Backwards . mapMaybe f . forwards
instance Filtrable f => Filtrable (Reverse f) where
mapMaybe f = Reverse . mapMaybe f . getReverse
infixl 4 <$?>, <*?>
-- | Infix synonym of 'mapMaybe'
(<$?>) :: Filtrable f => (a -> Maybe b) -> f a -> f b
(<$?>) = mapMaybe
-- | @f '<*?>' a = 'catMaybes' (f '<*>' a)@
(<*?>) :: (Applicative p, Filtrable p) => p (a -> Maybe b) -> p a -> p b
f <*?> a = catMaybes (f <*> a)
-- | \(\mathcal{O}(n^2)\)
-- Delete all but the first copy of each element, special case of 'nubBy'.
nub :: (Filtrable f, Traversable f, Eq a) => f a -> f a
nub = nubBy (==)
-- | \(\mathcal{O}(n^2)\)
-- Delete all but the first copy of each element, with the given relation.
nubBy :: (Filtrable f, Traversable f) => (a -> a -> Bool) -> f a -> f a
nubBy eq = fmap (flip M.evalState []) . filterA $ \ a -> do
as <- M.get
let b = all (not . eq a) as
b <$ when b (M.modify (a:))
-- | \(\mathcal{O}(n\;\mathrm{log}\;n)\)
-- Delete all but the first copy of each element, special case of 'nubOrdBy'.
nubOrd :: (Filtrable f, Traversable f, Ord a) => f a -> f a
nubOrd = nubOrdBy compare
-- | \(\mathcal{O}(n\;\mathrm{log}\;n)\)
-- Delete all but the first copy of each element, with the given relation.
nubOrdBy :: (Filtrable f, Traversable f) => (a -> a -> Ordering) -> f a -> f a
nubOrdBy compare = fmap (flip M.evalState Set.empty) . filterA $ \ a -> M.state $ \ as ->
case Set.insertBy' compare a as of
Nothing -> (False, as)
Just as' -> (True, as')
#ifdef MIN_VERSION_containers
instance Filtrable IntMap where
mapMaybe = IntMap.mapMaybe
mapEither = IntMap.mapEither
filter = IntMap.filter
instance Ord k => Filtrable (Map k) where
mapMaybe = Map.mapMaybe
mapEither = Map.mapEither
filter = Map.filter
instance Filtrable Seq where
mapMaybe f = go
where
go = \ case
Seq.Empty -> Seq.Empty
a Seq.:<| as -> maybe id (Seq.:<|) (f a) (go as)
#endif
filtrable-0.1.6.0/Data/Set/ 0000755 0000000 0000000 00000000000 07346545000 013415 5 ustar 00 0000000 0000000 filtrable-0.1.6.0/Data/Set/Private.hs 0000644 0000000 0000000 00000030051 07346545000 015362 0 ustar 00 0000000 0000000 {-# LANGUAGE CPP #-}
{-# LANGUAGE BangPatterns #-}
#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
{-# LANGUAGE Trustworthy #-}
#endif
{-# OPTIONS_HADDOCK not-home #-}
-----------------------------------------------------------------------------
-- |
-- Copyright : (c) Daan Leijen 2002
-- License : BSD-style
--
-- = WARNING
--
-- This module is considered __internal__.
--
-- The Package Versioning Policy __does not apply__.
--
-- This contents of this module may change __in any way whatsoever__
-- and __without any warning__ between minor versions of this package.
--
-- Authors importing this module are expected to track development
-- closely.
--
-- = Description
--
-- An efficient implementation of sets.
--
-- These modules are intended to be imported qualified, to avoid name
-- clashes with Prelude functions, e.g.
--
-- > import Data.Set (Set)
-- > import qualified Data.Set as Set
--
-- The implementation of 'Set' is based on /size balanced/ binary trees (or
-- trees of /bounded balance/) as described by:
--
-- * Stephen Adams, \"/Efficient sets: a balancing act/\",
-- Journal of Functional Programming 3(4):553-562, October 1993,
-- .
-- * J. Nievergelt and E.M. Reingold,
-- \"/Binary search trees of bounded balance/\",
-- SIAM journal of computing 2(1), March 1973.
--
-- Bounds for 'union', 'intersection', and 'difference' are as given
-- by
--
-- * Guy Blelloch, Daniel Ferizovic, and Yihan Sun,
-- \"/Just Join for Parallel Ordered Sets/\",
-- .
--
-- Note that the implementation is /left-biased/ -- the elements of a
-- first argument are always preferred to the second, for example in
-- 'union' or 'insert'. Of course, left-biasing can only be observed
-- when equality is an equivalence relation instead of structural
-- equality.
--
-- /Warning/: The size of the set must not exceed @maxBound::Int@. Violation of
-- this condition is not detected and if the size limit is exceeded, the
-- behavior of the set is completely undefined.
--
-- @since 0.5.9
-----------------------------------------------------------------------------
-- [Note: Using INLINABLE]
-- ~~~~~~~~~~~~~~~~~~~~~~~
-- It is crucial to the performance that the functions specialize on the Ord
-- type when possible. GHC 7.0 and higher does this by itself when it sees th
-- unfolding of a function -- that is why all public functions are marked
-- INLINABLE (that exposes the unfolding).
-- [Note: Using INLINE]
-- ~~~~~~~~~~~~~~~~~~~~
-- For other compilers and GHC pre 7.0, we mark some of the functions INLINE.
-- We mark the functions that just navigate down the tree (lookup, insert,
-- delete and similar). That navigation code gets inlined and thus specialized
-- when possible. There is a price to pay -- code growth. The code INLINED is
-- therefore only the tree navigation, all the real work (rebalancing) is not
-- INLINED by using a NOINLINE.
--
-- All methods marked INLINE have to be nonrecursive -- a 'go' function doing
-- the real work is provided.
-- [Note: Type of local 'go' function]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- If the local 'go' function uses an Ord class, it sometimes heap-allocates
-- the Ord dictionary when the 'go' function does not have explicit type.
-- In that case we give 'go' explicit type. But this slightly decrease
-- performance, as the resulting 'go' function can float out to top level.
-- [Note: Local 'go' functions and capturing]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- As opposed to IntSet, when 'go' function captures an argument, increased
-- heap-allocation can occur: sometimes in a polymorphic function, the 'go'
-- floats out of its enclosing function and then it heap-allocates the
-- dictionary and the argument. Maybe it floats out too late and strictness
-- analyzer cannot see that these could be passed on stack.
-- [Note: Order of constructors]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- The order of constructors of Set matters when considering performance.
-- Currently in GHC 7.0, when type has 2 constructors, a forward conditional
-- jump is made when successfully matching second constructor. Successful match
-- of first constructor results in the forward jump not taken.
-- On GHC 7.0, reordering constructors from Tip | Bin to Bin | Tip
-- improves the benchmark by up to 10% on x86.
module Data.Set.Private (
-- * Set type
Set(..) -- instance Eq,Ord,Show,Read,Data,Typeable
, Size
, insertBy'
, empty
) where
import Prelude hiding (filter,foldl,foldr,null,map,take,drop,splitAt)
import Control.Monad (join)
#if __GLASGOW_HASKELL__
import GHC.Exts ( lazy )
#endif
{--------------------------------------------------------------------
Sets are size balanced trees
--------------------------------------------------------------------}
-- | A set of values @a@.
-- See Note: Order of constructors
data Set a = Bin {-# UNPACK #-} !Size !a !(Set a) !(Set a) | Tip
type Size = Int
{--------------------------------------------------------------------
Query
--------------------------------------------------------------------}
-- | /O(1)/. The number of elements in the set.
size :: Set a -> Int
size Tip = 0
size (Bin sz _ _ _) = sz
{--------------------------------------------------------------------
Construction
--------------------------------------------------------------------}
-- | /O(1)/. The empty set.
empty :: Set a
empty = Tip
-- | /O(1)/. Create a singleton set.
singleton :: a -> Set a
singleton x = Bin 1 x Tip Tip
{--------------------------------------------------------------------
Insertion, Deletion
--------------------------------------------------------------------}
-- | /O(log n)/. Insert an element in a set.
-- If the set already contains an element equal to the given value,
-- it is replaced with the new value.
-- See Note: Type of local 'go' function
-- See Note: Avoiding worker/wrapper (in Data.Map.Internal)
insertBy' :: (a -> a -> Ordering) -> a -> Set a -> Maybe (Set a)
insertBy' compare = join go
where
go orig !_ Tip = Just $! singleton (lazy orig)
go orig !x (Bin _ y l r) = case compare x y of
LT -> (\ !l' -> balanceL y l' r) <$!> go orig x l
GT -> (\ !r' -> balanceR y l r') <$!> go orig x r
EQ -> Nothing
#if __GLASGOW_HASKELL__
{-# INLINABLE insertBy' #-}
#else
{-# INLINE insertBy' #-}
#endif
infixl 4 <$!>
(<$!>) :: (a -> b) -> Maybe a -> Maybe b
(<$!>) f = \ case
Nothing -> Nothing
Just a -> Just $! f a
#ifndef __GLASGOW_HASKELL__
lazy :: a -> a
lazy a = a
#endif
{--------------------------------------------------------------------
[balance x l r] balances two trees with value x.
The sizes of the trees should balance after decreasing the
size of one of them. (a rotation).
[delta] is the maximal relative difference between the sizes of
two trees, it corresponds with the [w] in Adams' paper.
[ratio] is the ratio between an outer and inner sibling of the
heavier subtree in an unbalanced setting. It determines
whether a double or single rotation should be performed
to restore balance. It is correspondes with the inverse
of $\alpha$ in Adam's article.
Note that according to the Adam's paper:
- [delta] should be larger than 4.646 with a [ratio] of 2.
- [delta] should be larger than 3.745 with a [ratio] of 1.534.
But the Adam's paper is errorneous:
- it can be proved that for delta=2 and delta>=5 there does
not exist any ratio that would work
- delta=4.5 and ratio=2 does not work
That leaves two reasonable variants, delta=3 and delta=4,
both with ratio=2.
- A lower [delta] leads to a more 'perfectly' balanced tree.
- A higher [delta] performs less rebalancing.
In the benchmarks, delta=3 is faster on insert operations,
and delta=4 has slightly better deletes. As the insert speedup
is larger, we currently use delta=3.
--------------------------------------------------------------------}
delta,ratio :: Int
delta = 3
ratio = 2
-- The balance function is equivalent to the following:
--
-- balance :: a -> Set a -> Set a -> Set a
-- balance x l r
-- | sizeL + sizeR <= 1 = Bin sizeX x l r
-- | sizeR > delta*sizeL = rotateL x l r
-- | sizeL > delta*sizeR = rotateR x l r
-- | otherwise = Bin sizeX x l r
-- where
-- sizeL = size l
-- sizeR = size r
-- sizeX = sizeL + sizeR + 1
--
-- rotateL :: a -> Set a -> Set a -> Set a
-- rotateL x l r@(Bin _ _ ly ry) | size ly < ratio*size ry = singleL x l r
-- | otherwise = doubleL x l r
-- rotateR :: a -> Set a -> Set a -> Set a
-- rotateR x l@(Bin _ _ ly ry) r | size ry < ratio*size ly = singleR x l r
-- | otherwise = doubleR x l r
--
-- singleL, singleR :: a -> Set a -> Set a -> Set a
-- singleL x1 t1 (Bin _ x2 t2 t3) = bin x2 (bin x1 t1 t2) t3
-- singleR x1 (Bin _ x2 t1 t2) t3 = bin x2 t1 (bin x1 t2 t3)
--
-- doubleL, doubleR :: a -> Set a -> Set a -> Set a
-- doubleL x1 t1 (Bin _ x2 (Bin _ x3 t2 t3) t4) = bin x3 (bin x1 t1 t2) (bin x2 t3 t4)
-- doubleR x1 (Bin _ x2 t1 (Bin _ x3 t2 t3)) t4 = bin x3 (bin x2 t1 t2) (bin x1 t3 t4)
--
-- It is only written in such a way that every node is pattern-matched only once.
--
-- Only balanceL and balanceR are needed at the moment, so balance is not here anymore.
-- In case it is needed, it can be found in Data.Map.
-- Functions balanceL and balanceR are specialised versions of balance.
-- balanceL only checks whether the left subtree is too big,
-- balanceR only checks whether the right subtree is too big.
-- balanceL is called when left subtree might have been inserted to or when
-- right subtree might have been deleted from.
balanceL :: a -> Set a -> Set a -> Set a
balanceL x l r = case r of
Tip -> case l of
Tip -> Bin 1 x Tip Tip
(Bin _ _ Tip Tip) -> Bin 2 x l Tip
(Bin _ lx Tip (Bin _ lrx _ _)) -> Bin 3 lrx (Bin 1 lx Tip Tip) (Bin 1 x Tip Tip)
(Bin _ lx ll@(Bin _ _ _ _) Tip) -> Bin 3 lx ll (Bin 1 x Tip Tip)
(Bin ls lx ll@(Bin lls _ _ _) lr@(Bin lrs lrx lrl lrr))
| lrs < ratio*lls -> Bin (1+ls) lx ll (Bin (1+lrs) x lr Tip)
| otherwise -> Bin (1+ls) lrx (Bin (1+lls+size lrl) lx ll lrl) (Bin (1+size lrr) x lrr Tip)
(Bin rs _ _ _) -> case l of
Tip -> Bin (1+rs) x Tip r
(Bin ls lx ll lr)
| ls > delta*rs -> case (ll, lr) of
(Bin lls _ _ _, Bin lrs lrx lrl lrr)
| lrs < ratio*lls -> Bin (1+ls+rs) lx ll (Bin (1+rs+lrs) x lr r)
| otherwise -> Bin (1+ls+rs) lrx (Bin (1+lls+size lrl) lx ll lrl) (Bin (1+rs+size lrr) x lrr r)
(_, _) -> error "Failure in Data.Map.balanceL"
| otherwise -> Bin (1+ls+rs) x l r
{-# NOINLINE balanceL #-}
-- balanceR is called when right subtree might have been inserted to or when
-- left subtree might have been deleted from.
balanceR :: a -> Set a -> Set a -> Set a
balanceR x l r = case l of
Tip -> case r of
Tip -> Bin 1 x Tip Tip
(Bin _ _ Tip Tip) -> Bin 2 x Tip r
(Bin _ rx Tip rr@(Bin _ _ _ _)) -> Bin 3 rx (Bin 1 x Tip Tip) rr
(Bin _ rx (Bin _ rlx _ _) Tip) -> Bin 3 rlx (Bin 1 x Tip Tip) (Bin 1 rx Tip Tip)
(Bin rs rx rl@(Bin rls rlx rll rlr) rr@(Bin rrs _ _ _))
| rls < ratio*rrs -> Bin (1+rs) rx (Bin (1+rls) x Tip rl) rr
| otherwise -> Bin (1+rs) rlx (Bin (1+size rll) x Tip rll) (Bin (1+rrs+size rlr) rx rlr rr)
(Bin ls _ _ _) -> case r of
Tip -> Bin (1+ls) x l Tip
(Bin rs rx rl rr)
| rs > delta*ls -> case (rl, rr) of
(Bin rls rlx rll rlr, Bin rrs _ _ _)
| rls < ratio*rrs -> Bin (1+ls+rs) rx (Bin (1+ls+rls) x l rl) rr
| otherwise -> Bin (1+ls+rs) rlx (Bin (1+ls+size rll) x l rll) (Bin (1+rrs+size rlr) rx rlr rr)
(_, _) -> error "Failure in Data.Map.balanceR"
| otherwise -> Bin (1+ls+rs) x l r
{-# NOINLINE balanceR #-}
filtrable-0.1.6.0/LICENSE 0000644 0000000 0000000 00000002743 07346545000 013024 0 ustar 00 0000000 0000000 © Unix year 45 (Strake = M Farkas-Dyck)
All rights reserved.
Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:
* Redistributions of source code must retain the above copyright
notice, this list of conditions and the following disclaimer.
* Redistributions in binary form must reproduce the above copyright
notice, this list of conditions and the following disclaimer in the
documentation and/or other materials provided with the distribution.
* Neither the name of the author nor the
names of its contributors may be used to endorse or promote products
derived from this software without specific prior written permission.
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE FOR ANY
DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
filtrable-0.1.6.0/filtrable.cabal 0000644 0000000 0000000 00000003441 07346545000 014743 0 ustar 00 0000000 0000000 name: filtrable
version: 0.1.6.0
synopsis: Class of filtrable containers
homepage: https://github.com/strake/filtrable.hs
license: BSD3
license-file: LICENSE
author: M Farkas-Dyck
maintainer: strake888@gmail.com
category: Data
build-type: Simple
cabal-version: >=1.10
tested-with: GHC ==8.0.*
GHC ==8.2.*
GHC ==8.4.*
GHC ==8.6.*
GHC ==8.8.*
description:
See "Data.Filtrable".
library
exposed-modules: Data.Filtrable
other-modules:
Data.Set.Private
build-depends: base >=4.9 && <5
, transformers >=0.5 && <0.6
if flag(containers)
build-depends: containers >=0.5.11 && <0.7
default-language: Haskell2010
default-extensions:
LambdaCase
ConstrainedClassMethods
ghc-options: -Wall -Wcompat -Wredundant-constraints -Wno-name-shadowing
-Wincomplete-record-updates -Wincomplete-uni-patterns
-Werror=incomplete-patterns
-Werror=incomplete-uni-patterns
-Werror=incomplete-record-updates
-Werror=missing-fields
-Werror=missing-methods
test-suite test
type: exitcode-stdio-1.0
hs-source-dirs: test
main-is: Spec.hs
default-language: Haskell2010
build-depends: base >=4.9 && <5
, filtrable
, smallcheck >=1.2 && <1.3
, tasty >=1.3.1 && <1.4
, tasty-smallcheck >=0.8.1 && <0.9
flag containers
description: instances for containers package
default: True
filtrable-0.1.6.0/test/ 0000755 0000000 0000000 00000000000 07346545000 012770 5 ustar 00 0000000 0000000 filtrable-0.1.6.0/test/Spec.hs 0000644 0000000 0000000 00000001632 07346545000 014220 0 ustar 00 0000000 0000000 {-# LANGUAGE PartialTypeSignatures #-}
module Main (main) where
import Prelude hiding (filter)
import Control.Applicative
import Data.Foldable
import Data.Filtrable
import qualified Data.List as List
import Test.SmallCheck
import Test.Tasty
import Test.Tasty.SmallCheck
main :: IO ()
main = defaultMain $ testGroup ""
[ testGroup "Filtrable"
[ testProperty "filter" (prop_filter :: _ -> [Maybe Bool] -> _)
]
, testGroup "nub"
[ testProperty "nub" (prop_nub :: [Int] -> _)
, testProperty "nubOrd" (prop_nubOrd :: [Int] -> _)
]
]
prop_filter :: (Filtrable f, Foldable f) => (a -> Bool) -> f a -> Bool
prop_filter = liftA2 (.) all filter
prop_nub :: (Filtrable f, Traversable f, Eq a) => f a -> Bool
prop_nub = (==) <$> List.nub . toList <*> toList . nub
prop_nubOrd :: (Filtrable f, Traversable f, Ord a) => f a -> Bool
prop_nubOrd = (==) <$> List.nub . toList <*> toList . nubOrd