ival 0.1.0.0 → 0.2.0.0

raw patch · 3 files changed

+69/−11 lines, 3 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ival.cabal +3/−2
• src/Data/Interval.hs +23/−8
• test/Main.hs +43/−1

@@ -1,5 +1,5 @@ name:                ival-version:             0.1.0.0+version:             0.2.0.0 synopsis:            Intervals -- description: license:             BSD3@@ -42,7 +42,8 @@   type:                exitcode-stdio-1.0   hs-source-dirs:      test   main-is:             Main.hs-  build-depends:       base >=4.11 && <5+  build-depends:       alg >=0.2.6 && <0.3+                     , base >=4.11 && <5                      , smallcheck >=1.1.4                      , tasty >=1.0                      , tasty-smallcheck >=0.8

@@ -1,10 +1,14 @@-module Data.Interval (Interval (..), (∪), (∩)) where+module Data.Interval (Interval (..), size, overlap, hull, isPoint) where -import Prelude hiding (Eq, Ord (..), max, min)+import Prelude hiding (Eq, Ord (..), Num (..), max, min, null) +import Algebra import Control.Applicative+import Control.Monad (guard) import Data.Function (on)+import Data.Maybe (fromMaybe) import Data.Ord (Down (..))+import Data.Semigroup (Sum (..)) import Relation.Binary.Comparison  infix 5 :–:@@ -13,13 +17,24 @@               Functor, Foldable, Traversable)  instance Preord a => Preord (Interval a) where-    a₁ :–: b₁ ≤ a₂ :–: b₂ = Lexical a₁ ≤ Lexical b₁ && ((≥) `on` Down . Lexical . fmap Down) a₂ b₂+    a₁ :–: b₁ ≤ a₂ :–: b₂ = Lexical a₁ ≥ Lexical a₂ && ((≤) `on` Down . Lexical . fmap Down) b₁ b₂ instance PartialEq a => PartialEq (Interval a) where a₁ :–: b₁ ≡ a₂ :–: b₂ = (a₁, b₁) ≡ (a₂, b₂) instance (PartialOrd a, PartialEq a) => PartialOrd (Interval a) instance Eq a => Eq (Interval a) -infixr 4 ∪, ∩-(∪), (∩) :: Ord a => Interval a -> Interval a -> Interval a-a₁ :–: b₁ ∪ a₂ :–: b₂ = liftA2 min a₁ a₂ :–: liftA2 max b₁ b₂-a₁ :–: b₁ ∩ a₂ :–: b₂ = fmap unMax (fmap Max a₁ <> fmap Max a₂) :–:-                        fmap unMin (fmap Min b₁ <> fmap Min b₂)+size :: Group (Sum a) => Interval a -> Maybe a+size (a :–: b) = liftA2 (-) b a++overlap :: Ord a => Interval a -> Interval a -> Maybe (Interval a)+overlap (a₁ :–: b₁) (a₂ :–: b₂) = z <$ (guard . not . null) z+  where z = fmap unMax (fmap Max a₁ <> fmap Max a₂) :–:+            fmap unMin (fmap Min b₁ <> fmap Min b₂)++hull :: Ord a => Interval a -> Interval a -> Interval a+hull (a₁ :–: b₁) (a₂ :–: b₂) = liftA2 min a₁ a₂ :–: liftA2 max b₁ b₂++null :: Ord a => Interval a -> Bool+null (a :–: b) = fromMaybe False $ liftA2 (>) a b++isPoint :: Eq a => Interval a -> Maybe a+isPoint (a :–: b) = a <* guard (a ≡ b)

@@ -1,8 +1,50 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE UndecidableInstances #-}+ module Main where +import Prelude hiding (Num (..), Ord (..))+import qualified Prelude+import Algebra+import Control.Applicative+import Data.Interval+import Data.Maybe (isJust)+import Data.Ratio+import Data.Semigroup (Product, Sum)+import Relation.Binary.Comparison as A import Test.SmallCheck+import Test.SmallCheck.Series import Test.Tasty import Test.Tasty.SmallCheck  main :: IO ()-main = defaultMain $ testGroup "" []+main = defaultMain $+    testGroup ""+    [testProperty "≤-reflexive" $ \ (a :: Interval Rational) -> a ≤ a,+     testProperty "≤-antisymmetric" $ \ (a :: Interval Rational) b -> (a ≤ b && b ≤ a) ≡ (a ≡ b),+     testProperty "≤-transitive" $ \ (a :: Interval Rational) b c -> not (a ≤ b && b ≤ c) || a ≤ c,+     testProperty "≤-overlap" $ \ (a :: Interval Rational) b -> (a ≤ b) ≡ (overlap a b ≡ Just a),+     testProperty "overlap-commutative" $ \ (a :: Interval Rational) b -> overlap a b ≡ overlap b a,+     testProperty "hull-commutative" $ \ (a :: Interval Rational) b -> overlap a b ≡ overlap b a]++instance (Serial m a, PartialOrd a) => Serial m (Interval a) where+    series = decDepth [a :–: b | a <- series, b <- series, a ≤ b]++instance (PartialOrd a, Semigroup (Product a)) => Preord (Ratio a) where+    (liftA2 (,) numerator denominator -> (an, ad)) ≤ (liftA2 (,) numerator denominator -> (bn, bd)) =+        an * bd ≤ bn * ad++instance (A.PartialOrd a, A.Eq a, Semigroup (Product a)) => A.Eq (Ratio a)++instance (PartialOrd a, Semigroup (Product a)) => PartialOrd (Ratio a) where+    tryCompare (liftA2 (,) numerator denominator -> (an, ad)) (liftA2 (,) numerator denominator -> (bn, bd)) =+        tryCompare (an * bd) (bn * ad)++instance (Ord a, Semigroup (Product a)) => Ord (Ratio a) where+    compare (liftA2 (,) numerator denominator -> (an, ad)) (liftA2 (,) numerator denominator -> (bn, bd)) =+        compare (an * bd) (bn * ad)++instance Group (Sum (Ratio Integer)) where+    invert = Prelude.negate