diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,7 +1,7 @@ -# Change log - -`pomaps` follows the [PVP][1]. -The change log is available [on GitHub][2]. - -[1]: https://pvp.haskell.org/ -[2]: https://github.com/sgraf812/pomaps/releases +# Change log + +`pomaps` follows the [PVP][1]. +The change log is available [on GitHub][2]. + +[1]: https://pvp.haskell.org/ +[2]: https://github.com/sgraf812/pomaps/releases diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,77 +1,77 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -import Algebra.PartialOrd -import Control.Arrow (first) -import Control.DeepSeq -import Criterion.Main -import qualified Data.POMap.Lazy as L -import qualified Data.POMap.Strict as S -import qualified Data.Vector as V -import System.Random - -newtype Divisibility - = Div { _unDiv :: Int } - deriving (Eq, Num, Show, Read, NFData) - -instance PartialOrd Divisibility where - leq (Div a) (Div b) = b `mod` a == 0 - -instance Bounded Divisibility where - minBound = Div 1 - maxBound = Div maxBound - -instance Random Divisibility where - randomR (Div l, Div h) = first Div . randomR (l, h) - random = randomR (minBound, maxBound) - -genElems :: Int -> [(Divisibility, Int)] -genElems n = zip (randoms (mkStdGen 0) :: [Divisibility]) [1 :: Int .. n] - -main :: IO () -main = defaultMain - [ bgroup "insert" - [ bgroup s - [ env - (pure (genElems n)) - (bench (show n) . whnf (foldr (uncurry insert) L.empty)) - | n <- [100, 1000, 2000] - ] - | (s, insert) <- [("Lazy", L.insert), ("Strict", S.insert)] - ] - , bgroup "lookup(present)" - [ env - (let elems = genElems n - m = L.fromList elems - k = fst (elems !! (length elems `div` 2)) - in pure (m, k)) - (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m)) - | n <- [100, 1000, 2000] - ] - , bgroup "lookup(absent)" - [ env - (let elems = genElems n - m = L.fromList elems - k = fst (random (mkStdGen (-1))) - in pure (m, k)) - (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m)) - | n <- [100, 1000, 2000] - ] - , bgroup "Vector.lookup(present)" - [ env - (let elems = genElems n - v = V.fromListN n elems - k = fst (elems !! (length elems `div` 2)) - in pure (v, k)) - (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v)) - | n <- [100, 1000, 2000] - ] - , bgroup "Vector.lookup(absent)" - [ env - (let elems = genElems n - v = V.fromListN n elems - k = fst (random (mkStdGen (-1))) - in pure (v, k)) - (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v)) - | n <- [100, 1000, 2000] - ] - ] +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +import Algebra.PartialOrd +import Control.Arrow (first) +import Control.DeepSeq +import Criterion.Main +import qualified Data.POMap.Lazy as L +import qualified Data.POMap.Strict as S +import qualified Data.Vector as V +import System.Random + +newtype Divisibility + = Div { _unDiv :: Int } + deriving (Eq, Num, Show, Read, NFData) + +instance PartialOrd Divisibility where + leq (Div a) (Div b) = b `mod` a == 0 + +instance Bounded Divisibility where + minBound = Div 1 + maxBound = Div maxBound + +instance Random Divisibility where + randomR (Div l, Div h) = first Div . randomR (l, h) + random = randomR (minBound, maxBound) + +genElems :: Int -> [(Divisibility, Int)] +genElems n = zip (randoms (mkStdGen 0) :: [Divisibility]) [1 :: Int .. n] + +main :: IO () +main = defaultMain + [ bgroup "insert" + [ bgroup s + [ env + (pure (genElems n)) + (bench (show n) . whnf (foldr (uncurry insert) L.empty)) + | n <- [100, 1000, 2000] + ] + | (s, insert) <- [("Lazy", L.insert), ("Strict", S.insert)] + ] + , bgroup "lookup(present)" + [ env + (let elems = genElems n + m = L.fromList elems + k = fst (elems !! (length elems `div` 2)) + in pure (m, k)) + (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m)) + | n <- [100, 1000, 2000] + ] + , bgroup "lookup(absent)" + [ env + (let elems = genElems n + m = L.fromList elems + k = fst (random (mkStdGen (-1))) + in pure (m, k)) + (\ ~(m, k) -> bench (show n) (whnf (L.lookup k) m)) + | n <- [100, 1000, 2000] + ] + , bgroup "Vector.lookup(present)" + [ env + (let elems = genElems n + v = V.fromListN n elems + k = fst (elems !! (length elems `div` 2)) + in pure (v, k)) + (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v)) + | n <- [100, 1000, 2000] + ] + , bgroup "Vector.lookup(absent)" + [ env + (let elems = genElems n + v = V.fromListN n elems + k = fst (random (mkStdGen (-1))) + in pure (v, k)) + (\ ~(v, k) -> bench (show n) (whnf (V.find ((== k) . fst)) v)) + | n <- [100, 1000, 2000] + ] + ] diff --git a/lattices/Algebra/PartialOrd.hs b/lattices/Algebra/PartialOrd.hs --- a/lattices/Algebra/PartialOrd.hs +++ b/lattices/Algebra/PartialOrd.hs @@ -1,154 +1,154 @@ -{-# LANGUAGE Safe #-} ----------------------------------------------------------------------------- --- | --- Module : Algebra.PartialOrd --- Copyright : (C) 2010-2015 Maximilian Bolingbroke --- License : BSD-3-Clause (see the file LICENSE) --- --- Maintainer : Oleg Grenrus --- ----------------------------------------------------------------------------- -module Algebra.PartialOrd ( - -- * Partial orderings - PartialOrd(..), - partialOrdEq, - - -- * Fixed points of chains in partial orders - lfpFrom, unsafeLfpFrom, - gfpFrom, unsafeGfpFrom - ) where - -import qualified Data.IntMap as IM -import qualified Data.IntSet as IS -import qualified Data.Map as M -import qualified Data.Set as S -import Data.Void (Void) - --- | A partial ordering on sets --- () is a set equipped --- with a binary relation, `leq`, that obeys the following laws --- --- @ --- Reflexive: a ``leq`` a --- Antisymmetric: a ``leq`` b && b ``leq`` a ==> a == b --- Transitive: a ``leq`` b && b ``leq`` c ==> a ``leq`` c --- @ --- --- Two elements of the set are said to be `comparable` when they are are --- ordered with respect to the `leq` relation. So --- --- @ --- `comparable` a b ==> a ``leq`` b || b ``leq`` a --- @ --- --- If `comparable` always returns true then the relation `leq` defines a --- total ordering (and an `Ord` instance may be defined). Any `Ord` instance is --- trivially an instance of `PartialOrd`. 'Algebra.Lattice.Ordered' provides a --- convenient wrapper to satisfy 'PartialOrd' given 'Ord'. --- --- As an example consider the partial ordering on sets induced by set --- inclusion. Then for sets `a` and `b`, --- --- @ --- a ``leq`` b --- @ --- --- is true when `a` is a subset of `b`. Two sets are `comparable` if one is a --- subset of the other. Concretely --- --- @ --- a = {1, 2, 3} --- b = {1, 3, 4} --- c = {1, 2} --- --- a ``leq`` a = `True` --- a ``leq`` b = `False` --- a ``leq`` c = `False` --- b ``leq`` a = `False` --- b ``leq`` b = `True` --- b ``leq`` c = `False` --- c ``leq`` a = `True` --- c ``leq`` b = `False` --- c ``leq`` c = `True` --- --- `comparable` a b = `False` --- `comparable` a c = `True` --- `comparable` b c = `False` --- @ -class Eq a => PartialOrd a where - -- | The relation that induces the partial ordering - leq :: a -> a -> Bool - - -- | Whether two elements are ordered with respect to the relation. A - -- default implementation is given by - -- - -- > comparable x y = leq x y || leq y x - comparable :: a -> a -> Bool - comparable x y = leq x y || leq y x - --- | The equality relation induced by the partial-order structure. It must obey --- the laws --- @ --- Reflexive: a == a --- Transitive: a == b && b == c ==> a == c --- @ -partialOrdEq :: PartialOrd a => a -> a -> Bool -partialOrdEq x y = leq x y && leq y x - -instance PartialOrd () where - leq _ _ = True - -instance PartialOrd Void where - leq _ _ = True - -instance Ord a => PartialOrd (S.Set a) where - leq = S.isSubsetOf - -instance PartialOrd IS.IntSet where - leq = IS.isSubsetOf - -instance (Ord k, PartialOrd v) => PartialOrd (M.Map k v) where - leq = M.isSubmapOfBy leq - -instance PartialOrd v => PartialOrd (IM.IntMap v) where - leq = IM.isSubmapOfBy leq - -instance (PartialOrd a, PartialOrd b) => PartialOrd (a, b) where - -- NB: *not* a lexical ordering. This is because for some component partial orders, lexical - -- ordering is incompatible with the transitivity axiom we require for the derived partial order - (x1, y1) `leq` (x2, y2) = x1 `leq` x2 && y1 `leq` y2 - --- | Least point of a partially ordered monotone function. Checks that the function is monotone. -lfpFrom :: PartialOrd a => a -> (a -> a) -> a -lfpFrom = lfpFrom' leq - --- | Least point of a partially ordered monotone function. Does not checks that the function is monotone. -unsafeLfpFrom :: Eq a => a -> (a -> a) -> a -unsafeLfpFrom = lfpFrom' (\_ _ -> True) - -{-# INLINE lfpFrom' #-} -lfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a -lfpFrom' check init_x f = go init_x - where go x | x' == x = x - | x `check` x' = go x' - | otherwise = error "lfpFrom: non-monotone function" - where x' = f x - - --- | Greatest fixed point of a partially ordered antinone function. Checks that the function is antinone. -{-# INLINE gfpFrom #-} -gfpFrom :: PartialOrd a => a -> (a -> a) -> a -gfpFrom = gfpFrom' leq - --- | Greatest fixed point of a partially ordered antinone function. Does not check that the function is antinone. -{-# INLINE unsafeGfpFrom #-} -unsafeGfpFrom :: Eq a => a -> (a -> a) -> a -unsafeGfpFrom = gfpFrom' (\_ _ -> True) - -{-# INLINE gfpFrom' #-} -gfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a -gfpFrom' check init_x f = go init_x - where go x | x' == x = x - | x' `check` x = go x' - | otherwise = error "gfpFrom: non-antinone function" - where x' = f x +{-# LANGUAGE Safe #-} +---------------------------------------------------------------------------- +-- | +-- Module : Algebra.PartialOrd +-- Copyright : (C) 2010-2015 Maximilian Bolingbroke +-- License : BSD-3-Clause (see the file LICENSE) +-- +-- Maintainer : Oleg Grenrus +-- +---------------------------------------------------------------------------- +module Algebra.PartialOrd ( + -- * Partial orderings + PartialOrd(..), + partialOrdEq, + + -- * Fixed points of chains in partial orders + lfpFrom, unsafeLfpFrom, + gfpFrom, unsafeGfpFrom + ) where + +import qualified Data.IntMap as IM +import qualified Data.IntSet as IS +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Void (Void) + +-- | A partial ordering on sets +-- () is a set equipped +-- with a binary relation, `leq`, that obeys the following laws +-- +-- @ +-- Reflexive: a ``leq`` a +-- Antisymmetric: a ``leq`` b && b ``leq`` a ==> a == b +-- Transitive: a ``leq`` b && b ``leq`` c ==> a ``leq`` c +-- @ +-- +-- Two elements of the set are said to be `comparable` when they are are +-- ordered with respect to the `leq` relation. So +-- +-- @ +-- `comparable` a b ==> a ``leq`` b || b ``leq`` a +-- @ +-- +-- If `comparable` always returns true then the relation `leq` defines a +-- total ordering (and an `Ord` instance may be defined). Any `Ord` instance is +-- trivially an instance of `PartialOrd`. 'Algebra.Lattice.Ordered' provides a +-- convenient wrapper to satisfy 'PartialOrd' given 'Ord'. +-- +-- As an example consider the partial ordering on sets induced by set +-- inclusion. Then for sets `a` and `b`, +-- +-- @ +-- a ``leq`` b +-- @ +-- +-- is true when `a` is a subset of `b`. Two sets are `comparable` if one is a +-- subset of the other. Concretely +-- +-- @ +-- a = {1, 2, 3} +-- b = {1, 3, 4} +-- c = {1, 2} +-- +-- a ``leq`` a = `True` +-- a ``leq`` b = `False` +-- a ``leq`` c = `False` +-- b ``leq`` a = `False` +-- b ``leq`` b = `True` +-- b ``leq`` c = `False` +-- c ``leq`` a = `True` +-- c ``leq`` b = `False` +-- c ``leq`` c = `True` +-- +-- `comparable` a b = `False` +-- `comparable` a c = `True` +-- `comparable` b c = `False` +-- @ +class Eq a => PartialOrd a where + -- | The relation that induces the partial ordering + leq :: a -> a -> Bool + + -- | Whether two elements are ordered with respect to the relation. A + -- default implementation is given by + -- + -- > comparable x y = leq x y || leq y x + comparable :: a -> a -> Bool + comparable x y = leq x y || leq y x + +-- | The equality relation induced by the partial-order structure. It must obey +-- the laws +-- @ +-- Reflexive: a == a +-- Transitive: a == b && b == c ==> a == c +-- @ +partialOrdEq :: PartialOrd a => a -> a -> Bool +partialOrdEq x y = leq x y && leq y x + +instance PartialOrd () where + leq _ _ = True + +instance PartialOrd Void where + leq _ _ = True + +instance Ord a => PartialOrd (S.Set a) where + leq = S.isSubsetOf + +instance PartialOrd IS.IntSet where + leq = IS.isSubsetOf + +instance (Ord k, PartialOrd v) => PartialOrd (M.Map k v) where + leq = M.isSubmapOfBy leq + +instance PartialOrd v => PartialOrd (IM.IntMap v) where + leq = IM.isSubmapOfBy leq + +instance (PartialOrd a, PartialOrd b) => PartialOrd (a, b) where + -- NB: *not* a lexical ordering. This is because for some component partial orders, lexical + -- ordering is incompatible with the transitivity axiom we require for the derived partial order + (x1, y1) `leq` (x2, y2) = x1 `leq` x2 && y1 `leq` y2 + +-- | Least point of a partially ordered monotone function. Checks that the function is monotone. +lfpFrom :: PartialOrd a => a -> (a -> a) -> a +lfpFrom = lfpFrom' leq + +-- | Least point of a partially ordered monotone function. Does not checks that the function is monotone. +unsafeLfpFrom :: Eq a => a -> (a -> a) -> a +unsafeLfpFrom = lfpFrom' (\_ _ -> True) + +{-# INLINE lfpFrom' #-} +lfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a +lfpFrom' check init_x f = go init_x + where go x | x' == x = x + | x `check` x' = go x' + | otherwise = error "lfpFrom: non-monotone function" + where x' = f x + + +-- | Greatest fixed point of a partially ordered antinone function. Checks that the function is antinone. +{-# INLINE gfpFrom #-} +gfpFrom :: PartialOrd a => a -> (a -> a) -> a +gfpFrom = gfpFrom' leq + +-- | Greatest fixed point of a partially ordered antinone function. Does not check that the function is antinone. +{-# INLINE unsafeGfpFrom #-} +unsafeGfpFrom :: Eq a => a -> (a -> a) -> a +unsafeGfpFrom = gfpFrom' (\_ _ -> True) + +{-# INLINE gfpFrom' #-} +gfpFrom' :: Eq a => (a -> a -> Bool) -> a -> (a -> a) -> a +gfpFrom' check init_x f = go init_x + where go x | x' == x = x + | x' `check` x = go x' + | otherwise = error "gfpFrom: non-antinone function" + where x' = f x diff --git a/pomaps.cabal b/pomaps.cabal --- a/pomaps.cabal +++ b/pomaps.cabal @@ -1,14 +1,16 @@ name: pomaps -version: 0.0.2.1 +version: 0.1.0.0 synopsis: Maps and sets of partial orders category: Data Structures homepage: https://github.com/sgraf812/pomaps#readme bug-reports: https://github.com/sgraf812/pomaps/issues +author: Sebastian Graf maintainer: Sebastian Graf license: MIT license-file: LICENSE.md build-type: Simple cabal-version: >= 1.10 +tested-with: GHC ==8.8.1 || ==8.6.5 || ==8.4.4 || ==8.2.2 extra-source-files: CHANGELOG.md @@ -36,7 +38,7 @@ src ghc-options: -Wall build-depends: - base >= 4.6.0.0 && < 4.13 + base >= 4.6.0.0 && < 4.14 -- oneShot , ghc-prim >= 0.4 && < 0.6 , deepseq >= 1.1 && < 1.5 @@ -44,10 +46,10 @@ -- so we have to track development really close. -- Data.Map.Internal is only available since 0.5.9, -- of which 0.5.9.2 is the first safe version - , containers >= 0.5.9.2 && <= 0.6.0.1 + , containers >= 0.5.9.2 && <= 0.6.2.1 if !flag(no-lattices) build-depends: - -- We need PartialOrd instances for () + -- We need PartialOrd instances for () lattices >= 1.7 exposed-modules: Data.POMap.Internal @@ -61,6 +63,7 @@ exposed-modules: Algebra.PartialOrd default-language: Haskell2010 + other-extensions: TypeApplications test-suite unittests type: exitcode-stdio-1.0 @@ -78,7 +81,7 @@ , ChasingBottoms if !flag(no-lattices) build-depends: - lattices < 2 + lattices other-modules: Data.POMap.Arbitrary Data.POMap.Divisibility @@ -113,7 +116,5 @@ , vector if !flag(no-lattices) build-depends: - lattices < 2 + lattices default-language: Haskell2010 - - diff --git a/src/Data/POSet.hs b/src/Data/POSet.hs --- a/src/Data/POSet.hs +++ b/src/Data/POSet.hs @@ -1,117 +1,117 @@ --- | --- Module : Data.POSet --- Copyright : (c) Sebastian Graf 2017 --- License : MIT --- Maintainer : sgraf1337@gmail.com --- Portability : portable --- --- A reasonably efficient implementation of partially ordered sets. --- --- These modules are intended to be imported qualified, to avoid name --- clashes with Prelude functions, e.g. --- --- > import qualified Data.POSet as POSet --- --- The implementation of 'POSet' is based on a decomposition of --- chains (totally ordered submaps), inspired by --- [\"Sorting and Selection in Posets\"](https://arxiv.org/abs/0707.1532). --- --- Operation comments contain the operation time complexity in --- [Big-O notation](http://en.wikipedia.org/wiki/Big_O_notation) and --- commonly refer to two characteristics of the poset from which keys are drawn: --- The number of elements in the set \(n\) and the /width/ \(w\) of the poset, --- referring to the size of the biggest anti-chain (set of incomparable elements). --- --- Generally speaking, lookup and mutation operations incur an additional --- factor of \(\mathcal{O}(w)\) compared to their counter-parts in "Data.Set". --- --- Note that for practical applications, the width of the poset should be --- in the order of \(w\in \mathcal{O}(\frac{n}{\log n})\), otherwise a simple lookup list --- is asymptotically superior. --- Even if that holds, the constants might be too big to be useful for any \(n\) that can --- can happen in practice. --- --- The following examples assume the following definitions for a set on the divisibility --- relation on `Int`egers: --- --- @ --- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-} --- --- import Algebra.PartialOrd --- import Data.POSet (POSet) --- import qualified Data.POSet as POSet --- --- newtype Divisibility --- = Div Int --- deriving (Eq, Read, Show, Num) --- --- default (Divisibility) --- --- instance 'PartialOrd' Divisibility where --- Div a \`leq\` Div b = b \`mod\` a == 0 --- --- type DivSet = POSet Divisibility --- --- -- We want integer literals to be interpreted as 'Divisibility's --- -- and default 'empty's to DivSet. --- default (Divisibility, DivSet) --- @ --- --- 'Divisility' is actually an example for a 'PartialOrd' that should not be used as keys of 'POSet'. --- Its width is \(w=\frac{n}{2}\in\Omega(n)\)! - -module Data.POSet - ( - -- * Set type - Impl.POSet - -- * Query - , Foldable.null - , Impl.size - , Impl.member - , Impl.notMember - , Impl.lookupLT - , Impl.lookupGT - , Impl.lookupLE - , Impl.lookupGE - , Impl.isSubsetOf - , Impl.isProperSubsetOf - - -- * Construction - , Impl.empty - , Impl.singleton - , Impl.insert - , Impl.delete - - -- * Combine - , Impl.union - , Impl.unions - , Impl.difference - , Impl.intersection - - -- * Filter - , Impl.filter - , Impl.partition - - -- * Map - , Impl.map - , Impl.mapMonotonic - - -- * Folds - , Foldable.foldr - , Foldable.foldl - -- ** Strict folds - , Impl.foldr' - , Impl.foldl' - - -- * Min\/Max - , Impl.lookupMin - , Impl.lookupMax - - -- * Conversion - , Impl.elems - , Impl.toList - , Impl.fromList - ) where - -import qualified Data.Foldable as Foldable -import qualified Data.POSet.Internal as Impl +-- | +-- Module : Data.POSet +-- Copyright : (c) Sebastian Graf 2017 +-- License : MIT +-- Maintainer : sgraf1337@gmail.com +-- Portability : portable +-- +-- A reasonably efficient implementation of partially ordered sets. +-- +-- These modules are intended to be imported qualified, to avoid name +-- clashes with Prelude functions, e.g. +-- +-- > import qualified Data.POSet as POSet +-- +-- The implementation of 'POSet' is based on a decomposition of +-- chains (totally ordered submaps), inspired by +-- [\"Sorting and Selection in Posets\"](https://arxiv.org/abs/0707.1532). +-- +-- Operation comments contain the operation time complexity in +-- [Big-O notation](http://en.wikipedia.org/wiki/Big_O_notation) and +-- commonly refer to two characteristics of the poset from which keys are drawn: +-- The number of elements in the set \(n\) and the /width/ \(w\) of the poset, +-- referring to the size of the biggest anti-chain (set of incomparable elements). +-- +-- Generally speaking, lookup and mutation operations incur an additional +-- factor of \(\mathcal{O}(w)\) compared to their counter-parts in "Data.Set". +-- +-- Note that for practical applications, the width of the poset should be +-- in the order of \(w\in \mathcal{O}(\frac{n}{\log n})\), otherwise a simple lookup list +-- is asymptotically superior. +-- Even if that holds, the constants might be too big to be useful for any \(n\) that can +-- can happen in practice. +-- +-- The following examples assume the following definitions for a set on the divisibility +-- relation on `Int`egers: +-- +-- @ +-- {-\# LANGUAGE GeneralizedNewtypeDeriving \#-} +-- +-- import Algebra.PartialOrd +-- import Data.POSet (POSet) +-- import qualified Data.POSet as POSet +-- +-- newtype Divisibility +-- = Div Int +-- deriving (Eq, Read, Show, Num) +-- +-- default (Divisibility) +-- +-- instance 'PartialOrd' Divisibility where +-- Div a \`leq\` Div b = b \`mod\` a == 0 +-- +-- type DivSet = POSet Divisibility +-- +-- -- We want integer literals to be interpreted as 'Divisibility's +-- -- and default 'empty's to DivSet. +-- default (Divisibility, DivSet) +-- @ +-- +-- 'Divisility' is actually an example for a 'PartialOrd' that should not be used as keys of 'POSet'. +-- Its width is \(w=\frac{n}{2}\in\Omega(n)\)! + +module Data.POSet + ( + -- * Set type + Impl.POSet + -- * Query + , Foldable.null + , Impl.size + , Impl.member + , Impl.notMember + , Impl.lookupLT + , Impl.lookupGT + , Impl.lookupLE + , Impl.lookupGE + , Impl.isSubsetOf + , Impl.isProperSubsetOf + + -- * Construction + , Impl.empty + , Impl.singleton + , Impl.insert + , Impl.delete + + -- * Combine + , Impl.union + , Impl.unions + , Impl.difference + , Impl.intersection + + -- * Filter + , Impl.filter + , Impl.partition + + -- * Map + , Impl.map + , Impl.mapMonotonic + + -- * Folds + , Foldable.foldr + , Foldable.foldl + -- ** Strict folds + , Impl.foldr' + , Impl.foldl' + + -- * Min\/Max + , Impl.lookupMin + , Impl.lookupMax + + -- * Conversion + , Impl.elems + , Impl.toList + , Impl.fromList + ) where + +import qualified Data.Foldable as Foldable +import qualified Data.POSet.Internal as Impl diff --git a/stack.yaml b/stack.yaml --- a/stack.yaml +++ b/stack.yaml @@ -1,64 +1,64 @@ -# This file was automatically generated by 'stack init' -# -# Some commonly used options have been documented as comments in this file. -# For advanced use and comprehensive documentation of the format, please see: -# http://docs.haskellstack.org/en/stable/yaml_configuration/ - -# Resolver to choose a 'specific' stackage snapshot or a compiler version. -# A snapshot resolver dictates the compiler version and the set of packages -# to be used for project dependencies. For example: -# -# resolver: lts-3.5 -# resolver: nightly-2015-09-21 -# resolver: ghc-7.10.2 -# resolver: ghcjs-0.1.0_ghc-7.10.2 -# resolver: -# name: custom-snapshot -# location: "./custom-snapshot.yaml" -resolver: lts-13.18 - -# User packages to be built. -# Various formats can be used as shown in the example below. -# -# packages: -# - some-directory -# - https://example.com/foo/bar/baz-0.0.2.tar.gz -# - location: -# git: https://github.com/commercialhaskell/stack.git -# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a -# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a -# extra-dep: true -# subdirs: -# - auto-update -# - wai -# -# A package marked 'extra-dep: true' will only be built if demanded by a -# non-dependency (i.e. a user package), and its test suites and benchmarks -# will not be run. This is useful for tweaking upstream packages. -packages: -- '.' -# Dependency packages to be pulled from upstream that are not in the resolver -# (e.g., acme-missiles-0.3) -extra-deps: -- ChasingBottoms-1.3.1.5 - -# Extra package databases containing global packages -extra-package-dbs: [] - -# Control whether we use the GHC we find on the path -# system-ghc: true -# -# Require a specific version of stack, using version ranges -# require-stack-version: -any # Default -# require-stack-version: ">=1.4" -# -# Override the architecture used by stack, especially useful on Windows -# arch: i386 -# arch: x86_64 -# -# Extra directories used by stack for building -# extra-include-dirs: [/path/to/dir] -# extra-lib-dirs: [/path/to/dir] -# -# Allow a newer minor version of GHC than the snapshot specifies -# compiler-check: newer-minor +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# http://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# resolver: ghcjs-0.1.0_ghc-7.10.2 +# resolver: +# name: custom-snapshot +# location: "./custom-snapshot.yaml" +resolver: lts-14.19 + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# - location: +# git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# - location: https://github.com/commercialhaskell/stack/commit/e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# extra-dep: true +# subdirs: +# - auto-update +# - wai +# +# A package marked 'extra-dep: true' will only be built if demanded by a +# non-dependency (i.e. a user package), and its test suites and benchmarks +# will not be run. This is useful for tweaking upstream packages. +packages: +- '.' +# Dependency packages to be pulled from upstream that are not in the resolver +# (e.g., acme-missiles-0.3) +extra-deps: +- ChasingBottoms-1.3.1.6 + +# Extra package databases containing global packages +extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=1.4" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/tests/Data/POMap/Arbitrary.hs b/tests/Data/POMap/Arbitrary.hs --- a/tests/Data/POMap/Arbitrary.hs +++ b/tests/Data/POMap/Arbitrary.hs @@ -1,10 +1,10 @@ -{-# OPTIONS_GHC -fno-warn-orphans #-} -module Data.POMap.Arbitrary where - -import Algebra.PartialOrd -import Data.POMap.Strict -import Test.Tasty.QuickCheck - -instance (PartialOrd k, Arbitrary k, Arbitrary v) => Arbitrary (POMap k v) where - arbitrary = fromList <$> arbitrary - shrink = fmap fromList . shrink . toList +{-# OPTIONS_GHC -fno-warn-orphans #-} +module Data.POMap.Arbitrary where + +import Algebra.PartialOrd +import Data.POMap.Strict +import Test.Tasty.QuickCheck + +instance (PartialOrd k, Arbitrary k, Arbitrary v) => Arbitrary (POMap k v) where + arbitrary = fromList <$> arbitrary + shrink = fmap fromList . shrink . toList diff --git a/tests/Data/POMap/Divisibility.hs b/tests/Data/POMap/Divisibility.hs --- a/tests/Data/POMap/Divisibility.hs +++ b/tests/Data/POMap/Divisibility.hs @@ -1,21 +1,21 @@ -{-# LANGUAGE GeneralizedNewtypeDeriving #-} - -module Data.POMap.Divisibility where - -import Algebra.PartialOrd -import Control.Arrow ((&&&)) -import Test.Tasty.QuickCheck - -newtype Divisibility - = Div { unDiv :: Integer } - deriving (Eq, Num, Show, Read) - -instance PartialOrd Divisibility where - leq (Div a) (Div b) = b `mod` a == 0 - -instance Arbitrary Divisibility where - arbitrary = Div . getPositive <$> arbitrary - shrink = fmap (Div . getPositive) . shrink . Positive . unDiv - -divisibility :: Int -> [(Divisibility, Integer)] -divisibility n = map ((Div &&& id) . fromIntegral) [1..n] +{-# LANGUAGE GeneralizedNewtypeDeriving #-} + +module Data.POMap.Divisibility where + +import Algebra.PartialOrd +import Control.Arrow ((&&&)) +import Test.Tasty.QuickCheck + +newtype Divisibility + = Div { unDiv :: Integer } + deriving (Eq, Num, Show, Read) + +instance PartialOrd Divisibility where + leq (Div a) (Div b) = b `mod` a == 0 + +instance Arbitrary Divisibility where + arbitrary = Div . getPositive <$> arbitrary + shrink = fmap (Div . getPositive) . shrink . Positive . unDiv + +divisibility :: Int -> [(Divisibility, Integer)] +divisibility n = map ((Div &&& id) . fromIntegral) [1..n] diff --git a/tests/Data/POMap/Properties.hs b/tests/Data/POMap/Properties.hs --- a/tests/Data/POMap/Properties.hs +++ b/tests/Data/POMap/Properties.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module Data.POMap.Properties where @@ -437,7 +438,7 @@ mapEither f m `shouldBe` ((fromList *** fromList) . Either.partitionEithers - . fmap (\(k, v) -> bimap ((,) k) ((,) k) (f v)) + . fmap (\(k, v) -> bimap (k,) (k,) (f v)) . toList) m describe "mapEitherWithKey" $ do @@ -449,7 +450,7 @@ mapEitherWithKey f m `shouldBe` ((fromList *** fromList) . Either.partitionEithers - . fmap (\(k, v) -> bimap ((,) k) ((,) k) (f k v)) + . fmap (\(k, v) -> bimap (k,) (k,) (f k v)) . toList) m diff --git a/tests/Data/POMap/Strictness.hs b/tests/Data/POMap/Strictness.hs --- a/tests/Data/POMap/Strictness.hs +++ b/tests/Data/POMap/Strictness.hs @@ -160,7 +160,7 @@ describe "type class instances" $ do describe "Functor" $ do - describe "fmap" $ + describe "<$>" $ it "always lazy" $ property $ \(m :: DivMap Int) -> shouldNotBeBottom (bottom <$ m) describe "<$" $ diff --git a/tests/Main.hs b/tests/Main.hs --- a/tests/Main.hs +++ b/tests/Main.hs @@ -1,13 +1,13 @@ -import qualified Data.POMap.Properties -import qualified Data.POMap.Strictness -import qualified Test.Tasty -import Test.Tasty.Hspec - -main :: IO () -main = do - props <- testSpec "properties" (parallel Data.POMap.Properties.spec) - strict <- testSpec "strictness" (parallel Data.POMap.Strictness.spec) - Test.Tasty.defaultMain $ Test.Tasty.testGroup "pomaps" - [ props - , strict - ] +import qualified Data.POMap.Properties +import qualified Data.POMap.Strictness +import qualified Test.Tasty +import Test.Tasty.Hspec + +main :: IO () +main = do + props <- testSpec "properties" (parallel Data.POMap.Properties.spec) + strict <- testSpec "strictness" (parallel Data.POMap.Strictness.spec) + Test.Tasty.defaultMain $ Test.Tasty.testGroup "pomaps" + [ props + , strict + ] diff --git a/tests/doctest-driver.hs b/tests/doctest-driver.hs --- a/tests/doctest-driver.hs +++ b/tests/doctest-driver.hs @@ -1,5 +1,5 @@ -import System.FilePath.Glob (glob) -import Test.DocTest (doctest) - -main :: IO () -main = glob "src/**/*.hs" >>= doctest +import System.FilePath.Glob (glob) +import Test.DocTest (doctest) + +main :: IO () +main = glob "src/**/*.hs" >>= doctest