summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMatthewFarkasDyck <>2020-08-01 04:56:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-08-01 04:56:00 (GMT)
commitd76fe25ce77896b9f53659dc3856e27c899cf1b6 (patch)
tree2fb860abfc7817ecb941205c07b394075cff0b97
parent81a016b6d9b7fc69d28f7b98914a572b9e3cc303 (diff)
version 0.1.5.00.1.5.0
-rw-r--r--Data/Filtrable.hs19
-rw-r--r--filtrable.cabal13
-rw-r--r--test/Spec.hs32
3 files changed, 58 insertions, 6 deletions
diff --git a/Data/Filtrable.hs b/Data/Filtrable.hs
index e6bfac5..f9bf18c 100644
--- a/Data/Filtrable.hs
+++ b/Data/Filtrable.hs
@@ -7,11 +7,13 @@ module Data.Filtrable
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
@@ -92,11 +94,18 @@ 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 (InL as) = InL (mapMaybe f as)
- mapMaybe f (InR bs) = InR (mapMaybe f bs)
+ 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 as) = Compose (mapMaybe f <$> as)
+ 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 <$?>, <*?>
@@ -119,12 +128,12 @@ nubBy eq = fmap (flip M.evalState []) . filterA $ \ a -> do
let b = all (not . eq a) as
b <$ when b (M.modify (a:))
--- | \(\mathcal{O}(n^2)\)
+-- | \(\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^2)\)
+-- | \(\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 ->
diff --git a/filtrable.cabal b/filtrable.cabal
index 270faca..7e835e3 100644
--- a/filtrable.cabal
+++ b/filtrable.cabal
@@ -1,5 +1,5 @@
name: filtrable
-version: 0.1.4.0
+version: 0.1.5.0
synopsis: Class of filtrable containers
homepage: https://github.com/strake/filtrable.hs
license: BSD3
@@ -34,3 +34,14 @@ library
-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
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..42d4ed1
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,32 @@
+{-# 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