diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown
--- a/CHANGELOG.markdown
+++ b/CHANGELOG.markdown
@@ -1,3 +1,41 @@
+2.1.2
+-----
+
+* fix `Data.IntegerInterval.width` (#38, thanks to ncfavier)
+* add `Data.IntegerInterval.memberCount` (#44, thanks to ncfavier)
+* add `instance Ord` for `Interval`, `IntervalSet` and `IntervalMap` (#41, thanks to googleson78)
+* fix `Data.IntervalSet.insert` (#43)
+
+2.1.1
+-----
+
+* fix boundary comparison in `relate` (#30, thanks to marcosh)
+* fix behaviour of `lattices` flag
+
+2.1.0
+-----
+
+* introduce operations for Allen's interval algebra (#18, thanks to marcosh)
+* make `recip` precise when 0 is not an interior point (#21)
+* add `instance Storable` for `Interval` (#25)
+* add `instance Floating` for `Interval` (#26)
+
+2.0.0
+-----
+* change internal representation of `Interval` and `IntegerInterval` to
+  reduce memory footprint (#7, thanks Bodigrim)
+* introduce `Boundary` type (#10, thanks Bodigrim)
+* export `isSingleton` function for `Interval` and `IntegerInterval` (#13)
+* remove deprecated `EndPoint` data type (#14, thanks Bodigrim)
+
+1.3.1
+-----
+* support lattices-2.0 (Thanks to Bodigrim).
+* move definitions of `Interval` and `IntegerInterval` data types into
+  internal modules and abstract away representations from the rest of
+  modules (Thanks to Bodigrim).
+
+
 1.3.0
 -----
 * add `Data.IntervalSet`, `Data.IntervalMap.Lazy`, `Data.IntervalMap.Strict` modules
diff --git a/README.md b/README.md
--- a/README.md
+++ b/README.md
@@ -1,7 +1,7 @@
 data-interval
 =============
 
-[![Build Status](https://travis-ci.org/msakai/data-interval.svg?branch=master)](https://travis-ci.org/msakai/data-interval)
+[![Build Status (GitHub Actions)](https://github.com/msakai/data-interval/actions/workflows/build.yaml/badge.svg)](https://github.com/msakai/data-interval/actions/workflows/build.yaml)
 [![Hackage](https://img.shields.io/hackage/v/data-interval.svg)](https://hackage.haskell.org/package/data-interval)
 [![Hackage Deps](https://img.shields.io/hackage-deps/v/data-interval.svg)](https://packdeps.haskellers.com/feed?needle=data-interval)
 [![Coverage Status](https://coveralls.io/repos/msakai/data-interval/badge.svg)](https://coveralls.io/r/msakai/data-interval)
diff --git a/data-interval.cabal b/data-interval.cabal
--- a/data-interval.cabal
+++ b/data-interval.cabal
@@ -1,11 +1,11 @@
 Name:		data-interval
-Version:	1.3.1
+Version:	2.1.2
 License:	BSD3
 License-File:	COPYING
 Author:		Masahiro Sakai (masahiro.sakai@gmail.com)
 Maintainer:	masahiro.sakai@gmail.com
 Category:	Data, Math
-Cabal-Version:	>= 1.10
+Cabal-Version:	2.0
 Synopsis:	Interval datatype, interval arithmetic and interval-based containers
 Description:
    Interval datatype, interval arithmetic and interval-based containers for Haskell.
@@ -13,47 +13,55 @@
    this package provides both open and closed intervals and is intended to be used
    with exact number types such as Rational and Integer.
 Bug-Reports:	https://github.com/msakai/data-interval/issues
-Extra-Source-Files:
+Extra-Doc-Files:
    README.md
-   COPYING
    CHANGELOG.markdown
 Build-Type: Simple
 Tested-With:
-   GHC ==7.8.4
-   GHC ==7.10.3
-   GHC ==8.0.2
    GHC ==8.2.2
    GHC ==8.4.4
-   GHC ==8.6.4
+   GHC ==8.6.5
+   GHC ==8.8.4
+   GHC ==8.10.7
+   GHC ==9.0.2
+   GHC ==9.2.8
+   GHC ==9.4.7
+   GHC ==9.6.2
+   GHC ==9.8.1
 
 source-repository head
   type:     git
-  location: git://github.com/msakai/data-interval.git
+  location: https://github.com/msakai/data-interval
 
+flag lattices
+  description: Derive lattice instances
+  default: True
+
 Library
   Hs-source-dirs: src
   Build-Depends:
-       base >=4 && <5
-     , containers
-     , lattices >=1.2.1.1 && <2.1
-     , deepseq
-     , hashable >=1.1.2.5 && <1.4
+       base >=4.10 && <5
+     , containers >= 0.5.8 && < 0.8
+     , deepseq < 1.6
+     , hashable >=1.1.2.5 && <1.5
      , extended-reals >=0.2 && <1.0
-  if impl(ghc <8.0)
-    Build-depends:
-      semigroups
+  if flag(lattices)
+    build-depends:
+     lattices >=2 && <2.3
   Default-Language: Haskell2010
   Other-Extensions:
-     CPP
      ScopedTypeVariables
      TypeFamilies
      DeriveDataTypeable
+     DeriveGeneric
+     LambdaCase
      MultiWayIf
      Safe
   Exposed-Modules:
      Data.Interval
      Data.IntervalMap.Lazy
      Data.IntervalMap.Strict
+     Data.IntervalRelation
      Data.IntervalSet
      Data.IntegerInterval
   Other-Modules:
@@ -65,25 +73,31 @@
   Type:              exitcode-stdio-1.0
   HS-Source-Dirs:    test
   Main-is:           TestSuite.hs
-  Other-Modules:     TestInterval, TestIntervalMap, TestIntervalSet, TestIntegerInterval
+  Other-Modules:
+     TestInterval
+     TestIntervalMap
+     TestIntervalRelation
+     TestIntervalSet
+     TestIntegerInterval
+     TestInstances
   Build-depends:
        base >=4 && <5
      , ChasingBottoms
      , containers
-     , lattices
      , deepseq
      , hashable
      , data-interval
      , syb
      , tasty >=0.10.1
      , tasty-hunit >=0.9 && <0.11
-     , tasty-quickcheck >=0.8 && <0.11
+     , tasty-quickcheck >=0.8.1 && <0.11
      , tasty-th
      , HUnit
      , QuickCheck >=2.5 && <3
-  if impl(ghc <7.10)
-    Build-depends:
-      transformers >=0.2
+     , quickcheck-classes-base
+  if flag(lattices)
+    build-depends:
+     lattices
   Default-Language: Haskell2010
   Other-Extensions:
      TemplateHaskell
diff --git a/src/Data/IntegerInterval.hs b/src/Data/IntegerInterval.hs
--- a/src/Data/IntegerInterval.hs
+++ b/src/Data/IntegerInterval.hs
@@ -13,7 +13,7 @@
 --
 -- Interval datatype and interval arithmetic over integers.
 --
--- Since 1.2.0
+-- @since 1.2.0
 --
 -- For the purpose of abstract interpretation, it might be convenient to use
 -- 'Lattice' instance. See also lattices package
@@ -25,6 +25,7 @@
   -- * Interval type
     IntegerInterval
   , module Data.ExtendedReal
+  , Boundary(..)
 
   -- * Construction
   , interval
@@ -38,15 +39,18 @@
 
   -- * Query
   , null
+  , isSingleton
   , member
   , notMember
   , isSubsetOf
   , isProperSubsetOf
+  , isConnected
   , lowerBound
   , upperBound
   , lowerBound'
   , upperBound'
   , width
+  , memberCount
 
   -- * Universal comparison operators
   , (<!), (<=!), (==!), (>=!), (>!), (/=!)
@@ -75,17 +79,24 @@
   , fromInterval
   , fromIntervalOver
   , fromIntervalUnder
+
+  -- * Intervals relation
+  , relate
   ) where
 
+#ifdef MIN_VERSION_lattices
 import Algebra.Lattice
+#endif
 import Control.Exception (assert)
 import Control.Monad hiding (join)
 import Data.ExtendedReal
-import Data.List hiding (null)
+import Data.List (foldl')
 import Data.Maybe
 import Prelude hiding (null)
 import Data.IntegerInterval.Internal
-import qualified Data.Interval as Interval
+import Data.Interval.Internal (Boundary(..))
+import qualified Data.Interval.Internal as Interval
+import Data.IntervalRelation
 
 infix 5 <..<=
 infix 5 <=..<
@@ -111,22 +122,21 @@
 
 -- | 'lowerBound' of the interval and whether it is included in the interval.
 -- The result is convenient to use as an argument for 'interval'.
-lowerBound' :: IntegerInterval -> (Extended Integer, Bool)
+lowerBound' :: IntegerInterval -> (Extended Integer, Boundary)
 lowerBound' x =
   case lowerBound x of
-    lb@(Finite _) -> (lb, True)
-    lb@_ -> (lb, False)
+    lb@(Finite _) -> (lb, Closed)
+    lb@_ -> (lb, Open)
 
 -- | 'upperBound' of the interval and whether it is included in the interval.
 -- The result is convenient to use as an argument for 'interval'.
-upperBound' :: IntegerInterval -> (Extended Integer, Bool)
+upperBound' :: IntegerInterval -> (Extended Integer, Boundary)
 upperBound' x =
   case upperBound x of
-    ub@(Finite _) -> (ub, True)
-    ub@_ -> (ub, False)
-
-#if MIN_VERSION_lattices(2,0,0)
+    ub@(Finite _) -> (ub, Closed)
+    ub@_ -> (ub, Open)
 
+#ifdef MIN_VERSION_lattices
 instance Lattice IntegerInterval where
   (\/) = hull
   (/\) = intersection
@@ -136,32 +146,13 @@
 
 instance BoundedMeetSemiLattice IntegerInterval where
   top = whole
-
-#else
-
-instance JoinSemiLattice IntegerInterval where
-  join = hull
-
-instance MeetSemiLattice IntegerInterval where
-  meet = intersection
-
-instance Lattice IntegerInterval
-
-instance BoundedJoinSemiLattice IntegerInterval where
-  bottom = empty
-
-instance BoundedMeetSemiLattice IntegerInterval where
-  top = whole
-
-instance BoundedLattice IntegerInterval
-
 #endif
 
 instance Show IntegerInterval where
   showsPrec _ x | null x = showString "empty"
   showsPrec p x =
     showParen (p > rangeOpPrec) $
-      showsPrec (rangeOpPrec+1) (lowerBound x) . 
+      showsPrec (rangeOpPrec+1) (lowerBound x) .
       showString " <=..<= " .
       showsPrec (rangeOpPrec+1) (upperBound x)
 
@@ -184,11 +175,11 @@
 
 -- | smart constructor for 'IntegerInterval'
 interval
-  :: (Extended Integer, Bool) -- ^ lower bound and whether it is included
-  -> (Extended Integer, Bool) -- ^ upper bound and whether it is included
+  :: (Extended Integer, Boundary) -- ^ lower bound and whether it is included
+  -> (Extended Integer, Boundary) -- ^ upper bound and whether it is included
   -> IntegerInterval
 interval (x1,in1) (x2,in2) =
-  (if in1 then x1 else x1 + 1) <=..<= (if in2 then x2 else x2 - 1)
+  (if in1 == Closed then x1 else x1 + 1) <=..<= (if in2 == Closed then x2 else x2 - 1)
 
 -- | left-open right-closed interval (@l@,@u@]
 (<..<=)
@@ -215,7 +206,7 @@
 whole :: IntegerInterval
 whole = NegInf <=..<= PosInf
 
--- | singleton set \[x,x\]
+-- | singleton set [x,x]
 singleton :: Integer -> IntegerInterval
 singleton x = Finite x <=..<= Finite x
 
@@ -248,6 +239,9 @@
 null :: IntegerInterval -> Bool
 null x = upperBound x < lowerBound x
 
+-- | Is the interval single point?
+--
+-- @since 2.0.0
 isSingleton :: IntegerInterval -> Bool
 isSingleton x = lowerBound x == upperBound x
 
@@ -268,15 +262,43 @@
 isProperSubsetOf :: IntegerInterval -> IntegerInterval -> Bool
 isProperSubsetOf i1 i2 = i1 /= i2 && i1 `isSubsetOf` i2
 
+-- | Does the union of two range form a set which is the intersection between the integers and a connected real interval?
+isConnected :: IntegerInterval -> IntegerInterval -> Bool
+isConnected x y = null x || null y || x ==? y || lb1nearUb2 || ub1nearLb2
+  where
+    lb1 = lowerBound x
+    lb2 = lowerBound y
+    ub1 = upperBound x
+    ub2 = upperBound y
+
+    lb1nearUb2 = case (lb1, ub2) of
+      (Finite lb1Int, Finite ub2Int) -> lb1Int == ub2Int + 1
+      _                              -> False
+
+    ub1nearLb2 = case (ub1, lb2) of
+      (Finite ub1Int, Finite lb2Int) -> ub1Int + 1 == lb2Int
+      _                              -> False
+
 -- | Width of a interval. Width of an unbounded interval is @undefined@.
 width :: IntegerInterval -> Integer
 width x
   | null x = 0
   | otherwise =
-      case (upperBound x, lowerBound x) of
+      case (lowerBound x, upperBound x) of
         (Finite lb, Finite ub) -> ub - lb
         _ -> error "Data.IntegerInterval.width: unbounded interval"
 
+-- | How many integers lie within the (bounded) interval.
+-- Equal to @Just (width + 1)@ for non-empty, bounded intervals.
+-- The @memberCount@ of an unbounded interval is @Nothing@.
+memberCount :: IntegerInterval -> Maybe Integer
+memberCount x
+  | null x = Just 0
+  | otherwise =
+      case (lowerBound x, upperBound x) of
+        (Finite lb, Finite ub) -> Just (ub - lb + 1)
+        _ -> Nothing
+
 -- | pick up an element from the interval if the interval is not empty.
 pickup :: IntegerInterval -> Maybe Integer
 pickup x =
@@ -292,7 +314,7 @@
 --
 -- * @'abs' y <= 'abs' y'@
 --
--- (see also 'approxRational' and 'Interval.simplestRationalWithin')
+-- (see also 'Data.Ratio.approxRational' and 'Interval.simplestRationalWithin')
 simplestIntegerWithin :: IntegerInterval -> Maybe Integer
 simplestIntegerWithin i
   | null i    = Nothing
@@ -385,9 +407,9 @@
     then f a b
     else liftM (\(y,x) -> (x,y)) $ f b a
   where
-    f a b = do
-      x <- pickup a
-      y <- msum [pickup (b `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]
+    f i j = do
+      x <- pickup i
+      y <- msum [pickup (j `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]
       return (x,y)
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?
@@ -456,31 +478,67 @@
 
 -- | Convert the interval to 'Interval.Interval' data type.
 toInterval :: Real r => IntegerInterval -> Interval.Interval r
-toInterval x = fmap fromInteger (lowerBound x) Interval.<=..<= fmap fromInteger (upperBound x)
+toInterval x = Interval.interval
+  (fmap fromInteger (lowerBound x), Closed)
+  (fmap fromInteger (upperBound x), Closed)
 
 -- | Conversion from 'Interval.Interval' data type.
 fromInterval :: Interval.Interval Integer -> IntegerInterval
-fromInterval i = (if in1 then x1 else x1 + 1) <=..<= (if in2 then x2 else x2 - 1)
+fromInterval i = x1' <=..<= x2'
   where
     (x1,in1) = Interval.lowerBound' i
     (x2,in2) = Interval.upperBound' i
+    x1' = case in1 of
+      Interval.Open   -> x1 + 1
+      Interval.Closed -> x1
+    x2' = case in2 of
+      Interval.Open   -> x2 - 1
+      Interval.Closed -> x2
 
 -- | Given a 'Interval.Interval' @I@ over R, compute the smallest 'IntegerInterval' @J@ such that @I ⊆ J@.
 fromIntervalOver :: RealFrac r => Interval.Interval r -> IntegerInterval
 fromIntervalOver i = fmap floor lb <=..<= fmap ceiling ub
   where
-    lb = Interval.lowerBound i
-    ub = Interval.upperBound i
+    (lb, _) = Interval.lowerBound' i
+    (ub, _) = Interval.upperBound' i
 
 -- | Given a 'Interval.Interval' @I@ over R, compute the largest 'IntegerInterval' @J@ such that @J ⊆ I@.
 fromIntervalUnder :: RealFrac r => Interval.Interval r -> IntegerInterval
-fromIntervalUnder i = fmap f lb <=..<= fmap g ub
+fromIntervalUnder i = lb <=..<= ub
   where
-    lb = Interval.lowerBound i
-    ub = Interval.upperBound i
-    f x = if fromIntegral y `Interval.member` i then y else y+1
-      where
-        y = ceiling x
-    g x = if fromIntegral y `Interval.member` i then y else y-1
-      where
-        y = floor x
+    lb = case Interval.lowerBound' i of
+      (Finite x, Open)
+        | fromInteger (ceiling x) == x
+        -> Finite (ceiling x + 1)
+      (x, _) -> fmap ceiling x
+    ub = case Interval.upperBound' i of
+      (Finite x, Open)
+        | fromInteger (floor x) == x
+        -> Finite (floor x - 1)
+      (x, _) -> fmap floor x
+
+-- | Computes how two intervals are related according to the @`Data.IntervalRelation.Relation`@ classification
+relate :: IntegerInterval -> IntegerInterval -> Relation
+relate i1 i2 =
+  case (i1 `isSubsetOf` i2, i2 `isSubsetOf` i1) of
+    -- 'i1' ad 'i2' are equal
+    (True , True ) -> Equal
+    -- 'i1' is strictly contained in `i2`
+    (True , False) | lowerBound i1 == lowerBound i2 -> Starts
+                   | upperBound i1 == upperBound i2 -> Finishes
+                   | otherwise                      -> During
+    -- 'i2' is strictly contained in `i1`
+    (False, True ) | lowerBound i1 == lowerBound i2 -> StartedBy
+                   | upperBound i1 == upperBound i2 -> FinishedBy
+                   | otherwise                      -> Contains
+    -- neither `i1` nor `i2` is contained in the other
+    (False, False) -> case ( null (i1 `intersection` i2)
+                           , lowerBound i1 <= lowerBound i2
+                           , i1 `isConnected` i2
+                           ) of
+      (True , True , True ) -> JustBefore
+      (True , True , False) -> Before
+      (True , False, True ) -> JustAfter
+      (True , False, False) -> After
+      (False, True , _    ) -> Overlaps
+      (False, False, _    ) -> OverlappedBy
diff --git a/src/Data/IntegerInterval/Internal.hs b/src/Data/IntegerInterval/Internal.hs
--- a/src/Data/IntegerInterval/Internal.hs
+++ b/src/Data/IntegerInterval/Internal.hs
@@ -1,9 +1,7 @@
 {-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, LambdaCase #-}
 {-# LANGUAGE Safe #-}
-#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
-#endif
 
 module Data.IntegerInterval.Internal
   ( IntegerInterval
@@ -21,7 +19,13 @@
 infix 5 <=..<=
 
 -- | The intervals (/i.e./ connected and convex subsets) over integers (__Z__).
-data IntegerInterval = Interval !(Extended Integer) !(Extended Integer)
+data IntegerInterval
+  = Whole
+  | Empty
+  | Point !Integer
+  | LessOrEqual !Integer
+  | GreaterOrEqual !Integer
+  | BothClosed !Integer !Integer
   deriving (Eq, Typeable)
 
 -- | Lower endpoint (/i.e./ greatest lower bound)  of the interval.
@@ -32,7 +36,13 @@
 --
 -- * 'lowerBound' of an interval may or may not be a member of the interval.
 lowerBound :: IntegerInterval -> Extended Integer
-lowerBound (Interval lb _) = lb
+lowerBound = \case
+  Whole            -> NegInf
+  Empty            -> PosInf
+  Point r          -> Finite r
+  LessOrEqual _    -> NegInf
+  GreaterOrEqual r -> Finite r
+  BothClosed p _   -> Finite p
 
 -- | Upper endpoint (/i.e./ least upper bound) of the interval.
 --
@@ -42,7 +52,13 @@
 --
 -- * 'upperBound' of an interval is a member of the interval.
 upperBound :: IntegerInterval -> Extended Integer
-upperBound (Interval _ ub) = ub
+upperBound = \case
+  Whole            -> PosInf
+  Empty            -> NegInf
+  Point r          -> Finite r
+  LessOrEqual r    -> Finite r
+  GreaterOrEqual _ -> PosInf
+  BothClosed _ p   -> Finite p
 
 -- This instance preserves data abstraction at the cost of inefficiency.
 -- We provide limited reflection services for the sake of data abstraction.
@@ -62,10 +78,22 @@
 intervalDataType = mkDataType "Data.IntegerInterval.Internal.IntegerInterval" [intervalConstr]
 
 instance NFData IntegerInterval where
-  rnf (Interval lb ub) = rnf lb `seq` rnf ub
+  rnf = \case
+    Whole            -> ()
+    Empty            -> ()
+    Point r          -> rnf r
+    LessOrEqual r    -> rnf r
+    GreaterOrEqual r -> rnf r
+    BothClosed p q   -> rnf p `seq` rnf q
 
 instance Hashable IntegerInterval where
-  hashWithSalt s (Interval lb ub) = s `hashWithSalt` lb `hashWithSalt` ub
+  hashWithSalt s = \case
+    Whole            -> s `hashWithSalt`  (1 :: Int)
+    Empty            -> s `hashWithSalt`  (2 :: Int)
+    Point r          -> s `hashWithSalt`  (3 :: Int) `hashWithSalt` r
+    LessOrEqual r    -> s `hashWithSalt`  (4 :: Int) `hashWithSalt` r
+    GreaterOrEqual r -> s `hashWithSalt`  (5 :: Int) `hashWithSalt` r
+    BothClosed p q   -> s `hashWithSalt`  (6 :: Int) `hashWithSalt` p `hashWithSalt` q
 
 -- | closed interval [@l@,@u@]
 (<=..<=)
@@ -74,10 +102,16 @@
   -> IntegerInterval
 (<=..<=) PosInf _ = empty
 (<=..<=) _ NegInf = empty
-(<=..<=) lb ub
-  | lb <= ub  = Interval lb ub
-  | otherwise = empty
+(<=..<=) NegInf PosInf = Whole
+(<=..<=) NegInf (Finite ub) = LessOrEqual ub
+(<=..<=) (Finite lb) PosInf = GreaterOrEqual lb
+(<=..<=) (Finite lb) (Finite ub) =
+  case compare lb ub of
+    EQ -> Point lb
+    LT -> BothClosed lb ub
+    GT -> Empty
+{-# INLINE (<=..<=) #-}
 
 -- | empty (contradicting) interval
 empty :: IntegerInterval
-empty = Interval PosInf NegInf
+empty = Empty
diff --git a/src/Data/Interval.hs b/src/Data/Interval.hs
--- a/src/Data/Interval.hs
+++ b/src/Data/Interval.hs
@@ -1,13 +1,11 @@
 {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
-{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables #-}
 {-# LANGUAGE Safe #-}
-#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
-#endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.Interval
--- Copyright   :  (c) Masahiro Sakai 2011-2013
+-- Copyright   :  (c) Masahiro Sakai 2011-2013, Andrew Lelechenko 2020
 -- License     :  BSD-style
 --
 -- Maintainer  :  masahiro.sakai@gmail.com
@@ -30,7 +28,7 @@
   -- * Interval type
     Interval
   , module Data.ExtendedReal
-  , EndPoint
+  , Boundary(..)
 
   -- * Construction
   , interval
@@ -44,6 +42,8 @@
 
   -- * Query
   , null
+  , isSingleton
+  , extractSingleton
   , member
   , notMember
   , isSubsetOf
@@ -76,14 +76,20 @@
   -- * Operations
   , pickup
   , simplestRationalWithin
+
+  -- * Intervals relation
+  , relate
   ) where
 
+#ifdef MIN_VERSION_lattices
 import Algebra.Lattice
+#endif
 import Control.Exception (assert)
 import Control.Monad hiding (join)
 import Data.ExtendedReal
 import Data.Interval.Internal
-import Data.List hiding (null)
+import Data.IntervalRelation
+import Data.List (foldl', maximumBy, minimumBy)
 import Data.Maybe
 import Data.Monoid
 import Data.Ratio
@@ -112,8 +118,7 @@
 infix 4 >??
 infix 4 /=??
 
-#if MIN_VERSION_lattices(2,0,0)
-
+#ifdef MIN_VERSION_lattices
 instance (Ord r) => Lattice (Interval r) where
   (\/) = hull
   (/\) = intersection
@@ -123,25 +128,6 @@
 
 instance (Ord r) => BoundedMeetSemiLattice (Interval r) where
   top = whole
-
-#else
-
-instance (Ord r) => JoinSemiLattice (Interval r) where
-  join = hull
-
-instance (Ord r) => MeetSemiLattice (Interval r) where
-  meet = intersection
-
-instance (Ord r) => Lattice (Interval r)
-
-instance (Ord r) => BoundedJoinSemiLattice (Interval r) where
-  bottom = empty
-
-instance (Ord r) => BoundedMeetSemiLattice (Interval r) where
-  top = whole
-
-instance (Ord r) => BoundedLattice (Interval r)
-
 #endif
 
 instance (Ord r, Show r) => Show (Interval r) where
@@ -154,7 +140,10 @@
     where
       (lb, in1) = lowerBound' i
       (ub, in2) = upperBound' i
-      op = (if in1 then "<=" else "<") ++ ".." ++ (if in2 then "<=" else "<")
+      op = sign in1 ++ ".." ++ sign in2
+      sign = \case
+        Open   -> "<"
+        Closed -> "<="
 
 instance (Ord r, Read r) => Read (Interval r) where
   readsPrec p r =
@@ -206,7 +195,7 @@
   => Extended r -- ^ lower bound @l@
   -> Extended r -- ^ upper bound @u@
   -> Interval r
-(<=..<=) lb ub = interval (lb, True) (ub, True)
+(<=..<=) lb ub = interval (lb, Closed) (ub, Closed)
 
 -- | left-open right-closed interval (@l@,@u@]
 (<..<=)
@@ -214,7 +203,7 @@
   => Extended r -- ^ lower bound @l@
   -> Extended r -- ^ upper bound @u@
   -> Interval r
-(<..<=) lb ub = interval (lb, False) (ub, True)
+(<..<=) lb ub = interval (lb, Open) (ub, Closed)
 
 -- | left-closed right-open interval [@l@, @u@)
 (<=..<)
@@ -222,7 +211,7 @@
   => Extended r -- ^ lower bound @l@
   -> Extended r -- ^ upper bound @u@
   -> Interval r
-(<=..<) lb ub = interval (lb, True) (ub, False)
+(<=..<) lb ub = interval (lb, Closed) (ub, Open)
 
 -- | open interval (@l@, @u@)
 (<..<)
@@ -230,15 +219,15 @@
   => Extended r -- ^ lower bound @l@
   -> Extended r -- ^ upper bound @u@
   -> Interval r
-(<..<) lb ub = interval (lb, False) (ub, False)
+(<..<) lb ub = interval (lb, Open) (ub, Open)
 
 -- | whole real number line (-∞, ∞)
 whole :: Ord r => Interval r
-whole = interval (NegInf, False) (PosInf, False)
+whole = interval (NegInf, Open) (PosInf, Open)
 
--- | singleton set \[x,x\]
+-- | singleton set [x,x]
 singleton :: Ord r => r -> Interval r
-singleton x = interval (Finite x, True) (Finite x, True)
+singleton x = interval (Finite x, Closed) (Finite x, Closed)
 
 -- | intersection of two intervals
 intersection :: forall r. Ord r => Interval r -> Interval r -> Interval r
@@ -246,26 +235,26 @@
   (maxLB (lowerBound' i1) (lowerBound' i2))
   (minUB (upperBound' i1) (upperBound' i2))
   where
-    maxLB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)
+    maxLB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)
     maxLB (x1,in1) (x2,in2) =
       ( max x1 x2
       , case x1 `compare` x2 of
-          EQ -> in1 && in2
+          EQ -> in1 `min` in2
           LT -> in2
           GT -> in1
       )
-    minUB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)
+    minUB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)
     minUB (x1,in1) (x2,in2) =
       ( min x1 x2
       , case x1 `compare` x2 of
-          EQ -> in1 && in2
+          EQ -> in1 `min` in2
           LT -> in1
           GT -> in2
       )
 
 -- | intersection of a list of intervals.
 --
--- Since 0.6.0
+-- @since 0.6.0
 intersections :: Ord r => [Interval r] -> Interval r
 intersections = foldl' intersection whole
 
@@ -278,26 +267,26 @@
   (minLB (lowerBound' i1) (lowerBound' i2))
   (maxUB (upperBound' i1) (upperBound' i2))
   where
-    maxUB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)
+    maxUB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)
     maxUB (x1,in1) (x2,in2) =
       ( max x1 x2
       , case x1 `compare` x2 of
-          EQ -> in1 || in2
+          EQ -> in1 `max` in2
           LT -> in2
           GT -> in1
       )
-    minLB :: (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)
+    minLB :: (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)
     minLB (x1,in1) (x2,in2) =
       ( min x1 x2
       , case x1 `compare` x2 of
-          EQ -> in1 || in2
+          EQ -> in1 `max` in2
           LT -> in1
           GT -> in2
       )
 
 -- | convex hull of a list of intervals.
 --
--- Since 0.6.0
+-- @since 0.6.0
 hulls :: Ord r => [Interval r] -> Interval r
 hulls = foldl' hull empty
 
@@ -305,26 +294,40 @@
 null :: Ord r => Interval r -> Bool
 null i =
   case x1 `compare` x2 of
-    EQ -> assert (in1 && in2) False
+    EQ -> assert (in1 == Closed && in2 == Closed) False
     LT -> False
     GT -> True
   where
     (x1, in1) = lowerBound' i
     (x2, in2) = upperBound' i
 
+-- | Is the interval single point?
+--
+-- @since 2.0.0
 isSingleton :: Ord r => Interval r -> Bool
-isSingleton i = case (lowerBound' i, upperBound' i) of
-  ((Finite l, True), (Finite u, True)) -> l==u
-  _ -> False
+isSingleton = isJust . extractSingleton
 
+-- | If the interval is a single point, return this point.
+--
+-- @since 2.1.0
+extractSingleton :: Ord r => Interval r -> Maybe r
+extractSingleton i = case (lowerBound' i, upperBound' i) of
+  ((Finite l, Closed), (Finite u, Closed))
+    | l == u -> Just l
+  _ -> Nothing
+
 -- | Is the element in the interval?
 member :: Ord r => r -> Interval r -> Bool
 member x i = condLB && condUB
   where
     (x1, in1) = lowerBound' i
     (x2, in2) = upperBound' i
-    condLB = if in1 then x1 <= Finite x else x1 < Finite x
-    condUB = if in2 then Finite x <= x2 else Finite x < x2
+    condLB = case in1 of
+      Open   -> x1 <  Finite x
+      Closed -> x1 <= Finite x
+    condUB = case in2 of
+      Open   -> Finite x <  x2
+      Closed -> Finite x <= x2
 
 -- | Is the element not in the interval?
 notMember :: Ord r => r -> Interval r -> Bool
@@ -339,12 +342,12 @@
       case x1 `compare` x2 of
         GT -> True
         LT -> False
-        EQ -> not in1 || in2 -- in1 => in2
+        EQ -> in1 <= in2
     testUB (x1,in1) (x2,in2) =
       case x1 `compare` x2 of
         LT -> True
         GT -> False
-        EQ -> not in1 || in2 -- in1 => in2
+        EQ -> in1 <= in2
 
 -- | Is this a proper subset? (/i.e./ a subset but not equal).
 isProperSubsetOf :: Ord r => Interval r -> Interval r -> Bool
@@ -352,12 +355,12 @@
 
 -- | Does the union of two range form a connected set?
 --
--- Since 1.3.0
+-- @since 1.3.0
 isConnected :: Ord r => Interval r -> Interval r -> Bool
 isConnected x y
   | null x = True
   | null y = True
-  | otherwise = x ==? y || (lb1==ub2 && (lb1in || ub2in)) || (ub1==lb2 && (ub1in || lb2in))
+  | otherwise = x ==? y || (lb1==ub2 && (lb1in == Closed || ub2in == Closed)) || (ub1==lb2 && (ub1in == Closed || lb2in == Closed))
   where
     (lb1,lb1in) = lowerBound' x
     (lb2,lb2in) = lowerBound' y
@@ -376,13 +379,17 @@
 pickup :: (Real r, Fractional r) => Interval r -> Maybe r
 pickup i = case (lowerBound' i, upperBound' i) of
   ((NegInf,_), (PosInf,_))             -> Just 0
-  ((Finite x1, in1), (PosInf,_))       -> Just $ if in1 then x1 else x1+1
-  ((NegInf,_), (Finite x2, in2))       -> Just $ if in2 then x2 else x2-1
+  ((Finite x1, in1), (PosInf,_))       -> Just $ case in1 of
+    Open   -> x1 + 1
+    Closed -> x1
+  ((NegInf,_), (Finite x2, in2))       -> Just $ case in2 of
+    Open   -> x2 - 1
+    Closed -> x2
   ((Finite x1, in1), (Finite x2, in2)) ->
     case x1 `compare` x2 of
       GT -> Nothing
       LT -> Just $ (x1+x2) / 2
-      EQ -> if in1 && in2 then Just x1 else Nothing
+      EQ -> if in1 == Closed && in2 == Closed then Just x1 else Nothing
   _ -> Nothing
 
 -- | 'simplestRationalWithin' returns the simplest rational number within the interval.
@@ -395,7 +402,7 @@
 --
 -- (see also 'approxRational')
 --
--- Since 0.4.0
+-- @since 0.4.0
 simplestRationalWithin :: RealFrac r => Interval r -> Maybe Rational
 simplestRationalWithin i | null i = Nothing
 simplestRationalWithin i
@@ -403,21 +410,30 @@
   | i <! 0    = Just $ - go (- i)
   | otherwise = assert (0 `member` i) $ Just 0
   where
-    go i
-      | fromInteger lb_floor       `member` i = fromInteger lb_floor
-      | fromInteger (lb_floor + 1) `member` i = fromInteger (lb_floor + 1)
-      | otherwise = fromInteger lb_floor + recip (go (recip (i - singleton (fromInteger lb_floor))))
+    go j
+      | fromInteger lb_floor       `member` j = fromInteger lb_floor
+      | fromInteger (lb_floor + 1) `member` j = fromInteger (lb_floor + 1)
+      | otherwise = fromInteger lb_floor + recip (go (recip (j - singleton (fromInteger lb_floor))))
       where
-        Finite lb = lowerBound i
+        Finite lb = lowerBound j
         lb_floor  = floor lb
 
--- | @mapMonotonic f i@ is the image of @i@ under @f@, where @f@ must be a strict monotone function.
+-- | @mapMonotonic f i@ is the image of @i@ under @f@, where @f@ must be a strict monotone function,
+-- preserving negative and positive infinities.
 mapMonotonic :: (Ord a, Ord b) => (a -> b) -> Interval a -> Interval b
 mapMonotonic f i = interval (fmap f lb, in1) (fmap f ub, in2)
   where
     (lb, in1) = lowerBound' i
     (ub, in2) = upperBound' i
 
+mapAntiMonotonic :: (Ord a, Ord b) => (a -> b) -> Interval a -> Interval b
+mapAntiMonotonic f i
+  | null i = empty
+  | otherwise = interval (fmap f ub, in2) (fmap f lb, in1)
+  where
+    (lb, in1) = lowerBound' i
+    (ub, in2) = upperBound' i
+
 -- | For all @x@ in @X@, @y@ in @Y@. @x '<' y@?
 (<!) :: Ord r => Interval r -> Interval r -> Bool
 a <! b =
@@ -428,7 +444,7 @@
       case ub_a of
         NegInf   -> True -- a is empty, so it holds vacuously
         PosInf   -> True -- b is empty, so it holds vacuously
-        Finite _ -> not (in1 && in2)
+        Finite _ -> in1 == Open || in2 == Open
   where
     (ub_a, in1) = upperBound' a
     (lb_b, in2) = lowerBound' b
@@ -443,7 +459,7 @@
 
 -- | For all @x@ in @X@, @y@ in @Y@. @x '/=' y@?
 --
--- Since 1.0.1
+-- @since 1.0.1
 (/=!) :: Ord r => Interval r -> Interval r -> Bool
 a /=! b = null $ a `intersection` b
 
@@ -464,7 +480,7 @@
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<' y@?
 --
--- Since 1.0.0
+-- @since 1.0.0
 (<??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r)
 a <?? b = do
   guard $ lowerBound a < upperBound b
@@ -491,14 +507,14 @@
       case lb_a of
         NegInf -> False -- b is empty
         PosInf -> False -- a is empty
-        Finite _ -> in1 && in2
+        Finite _ -> in1 == Closed && in2 == Closed
   where
     (lb_a, in1) = lowerBound' a
     (ub_b, in2) = upperBound' b
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '<=' y@?
 --
--- Since 1.0.0
+-- @since 1.0.0
 (<=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r)
 a <=?? b =
   case pickup (intersection a b) of
@@ -511,13 +527,13 @@
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?
 --
--- Since 1.0.0
+-- @since 1.0.0
 (==?) :: Ord r => Interval r -> Interval r -> Bool
 a ==? b = not $ null $ intersection a b
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '==' y@?
 --
--- Since 1.0.0
+-- @since 1.0.0
 (==??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r)
 a ==?? b = do
   x <- pickup (intersection a b)
@@ -525,13 +541,13 @@
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@?
 --
--- Since 1.0.1
+-- @since 1.0.1
 (/=?) :: Ord r => Interval r -> Interval r -> Bool
 a /=? b = not (null a) && not (null b) && not (a == b && isSingleton a)
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '/=' y@?
 --
--- Since 1.0.1
+-- @since 1.0.1
 (/=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r)
 a /=?? b = do
   guard $ not $ null a
@@ -541,9 +557,9 @@
     then f a b
     else liftM (\(y,x) -> (x,y)) $ f b a
   where
-    f a b = do
-      x <- pickup a
-      y <- msum [pickup (b `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]
+    f i j = do
+      x <- pickup i
+      y <- msum [pickup (j `intersection` c) | c <- [-inf <..< Finite x, Finite x <..< inf]]
       return (x,y)
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?
@@ -556,13 +572,13 @@
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>=' y@?
 --
--- Since 1.0.0
+-- @since 1.0.0
 (>=??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r)
 (>=??) = flip (<=??)
 
 -- | Does there exist an @x@ in @X@, @y@ in @Y@ such that @x '>' y@?
 --
--- Since 1.0.0
+-- @since 1.0.0
 (>??) :: (Real r, Fractional r) => Interval r -> Interval r -> Maybe (r,r)
 (>??) = flip (<??)
 
@@ -583,19 +599,21 @@
     lb = lowerBound' x
     ub = upperBound' x
 
+-- | When results of 'abs' or 'signum' do not form a connected interval,
+-- a convex hull is returned instead.
 instance (Num r, Ord r) => Num (Interval r) where
   a + b
     | null a || null b = empty
     | otherwise = interval (f (lowerBound' a) (lowerBound' b)) (g (upperBound' a) (upperBound' b))
     where
-      f (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 && in2)
-      f (NegInf,_) _ = (-inf, False)
-      f _ (NegInf,_) = (-inf, False)
+      f (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 `min` in2)
+      f (NegInf,_) _ = (-inf, Open)
+      f _ (NegInf,_) = (-inf, Open)
       f _ _ = error "Interval.(+) should not happen"
 
-      g (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 && in2)
-      g (PosInf,_) _ = (inf, False)
-      g _ (PosInf,_) = (inf, False)
+      g (Finite x1, in1) (Finite x2, in2) = (Finite (x1+x2), in1 `min` in2)
+      g (PosInf,_) _ = (inf, Open)
+      g _ (PosInf,_) = (inf, Open)
       g _ _ = error "Interval.(+) should not happen"
 
   negate = scaleInterval (-1)
@@ -624,26 +642,147 @@
       ub3 = maximumBy cmpUB xs
       lb3 = minimumBy cmpLB xs
 
+-- | 'recip' returns 'whole' when 0 is an interior point.
+-- Otherwise @recip (recip xs)@ equals to @xs@ without 0.
 instance forall r. (Real r, Fractional r) => Fractional (Interval r) where
   fromRational r = singleton (fromRational r)
   recip a
     | null a = empty
-    | 0 `member` a = whole -- should be error?
+    | a == 0 = empty
+    | 0 `member` a && 0 /= lowerBound a && 0 /= upperBound a = whole
     | otherwise = interval lb3 ub3
     where
       ub3 = maximumBy cmpUB xs
       lb3 = minimumBy cmpLB xs
       xs = [recipLB (lowerBound' a), recipUB (upperBound' a)]
 
-cmpUB, cmpLB :: Ord r => (Extended r, Bool) -> (Extended r, Bool) -> Ordering
+-- | When results of 'tan' or '**' do not form a connected interval,
+-- a convex hull is returned instead.
+instance (RealFrac r, Floating r) => Floating (Interval r) where
+  pi = singleton pi
+
+  exp = intersection (0 <..< PosInf) . mapMonotonic exp
+  log a = interval (logB (lowerBound' b)) (logB (upperBound' b))
+    where
+      b = intersection (0 <..< PosInf) a
+
+  sqrt = mapMonotonic sqrt . intersection (0 <=..< PosInf)
+
+  a ** b = hulls (posBase : negBasePosPower : negBaseNegPower : zeroPower ++ zeroBase)
+    where
+      posBase = exp (log a * b)
+      zeroPower = [ 1 | 0 `member` b, not (null a) ]
+      zeroBase  = [ 0 | 0 `member` a, not (null (b `intersection` (0 <..< PosInf))) ]
+      negBasePosPower = positiveIntegralPowersOfNegativeValues
+        (a `intersection` (NegInf <..< 0))
+        (b `intersection` (0 <..< PosInf))
+      negBaseNegPower = positiveIntegralPowersOfNegativeValues
+        (recip  (a `intersection` (NegInf <..< 0)))
+        (negate (b `intersection` (NegInf <..< 0)))
+
+  cos a = case lowerBound' a of
+    (NegInf, _) -> -1 <=..<= 1
+    (PosInf, _) -> empty
+    (Finite lb, in1) -> case upperBound' a of
+      (NegInf, _) -> empty
+      (PosInf, _) -> -1 <=..<= 1
+      (Finite ub, in2)
+        | ub - lb > 2 * pi                                             -> -1 <=..<= 1
+        | clb == -1 && ub - lb == 2 * pi && in1 == Open && in2 == Open -> -1 <..<= 1
+        | clb ==  1 && ub - lb == 2 * pi && in1 == Open && in2 == Open -> -1 <=..< 1
+        | ub - lb == 2 * pi                                            -> -1 <=..<= 1
+
+        | lbNorth, ubNorth, clb >= cub -> interval (cub, in2) (clb, in1)
+        | lbNorth, ubNorth -> -1 <=..<= 1
+        | lbNorth -> interval (-1, Closed) $ case clb `compare` cub of
+          LT -> (cub, in2)
+          EQ -> (cub, in1 `max` in2)
+          GT -> (clb, in1)
+        | ubNorth -> (`interval` (1, Closed)) $ case clb `compare` cub of
+          LT -> (clb, in1)
+          EQ -> (clb, in1 `max` in2)
+          GT -> (cub, in2)
+        | clb > cub -> -1 <=..<= 1
+        | otherwise -> interval (clb, in1) (cub, in2)
+        where
+          mod2pi x = let y = x / (2 * pi) in y - fromInteger (floor y)
+          -- is lower bound in the northern half-plane [0,pi)?
+          lbNorth = (mod2pi lb, in1) < (1 / 2, Closed)
+          -- is upper bound in the northern half-plane [0,pi)?
+          ubNorth = (mod2pi ub, in2) < (1 / 2, Closed)
+          clb = Finite (cos lb)
+          cub = Finite (cos ub)
+
+  acos = mapAntiMonotonic acos . intersection (-1 <=..<= 1)
+
+  sin a = cos (pi / 2 - a)
+  asin = mapMonotonic asin . intersection (-1 <=..<= 1)
+
+  tan a = case lowerBound' a of
+    (NegInf, _) -> whole
+    (PosInf, _) -> empty
+    (Finite lb, in1) -> case upperBound' a of
+      (NegInf, _) -> empty
+      (PosInf, _) -> whole
+      (Finite ub, in2)
+        | ub - lb > pi -> whole
+        -- the next case corresponds to (tan lb, +inf) + (-inf, tan ub)
+        -- with tan lb == tan ub, but a convex hull is returned instead
+        | ub - lb == pi && in1 == Open && in2 == Open && modpi lb /= 1/2 -> whole
+        | ub - lb == pi -> whole
+        | tan lb <= tan ub -> interval (Finite $ tan lb, in1) (Finite $ tan ub, in2)
+        -- the next case corresponds to (tan lb, +inf) + (-inf, tan ub),
+        -- but a convex hull is returned instead
+        | otherwise -> whole
+        where
+          modpi x = let y = x / pi in y - fromInteger (floor y)
+
+  atan = intersection (Finite (-pi / 2) <=..<= Finite (pi / 2)) . mapMonotonic atan
+
+  sinh  = mapMonotonic sinh
+  asinh = mapMonotonic asinh
+
+  cosh  = mapMonotonic cosh . abs
+  acosh = mapMonotonic acosh . intersection (1 <=..< PosInf)
+
+  tanh  = intersection (-1 <..< 1) . mapMonotonic tanh
+  atanh a = interval (atanhB (lowerBound' b)) (atanhB (upperBound' b))
+    where
+      b = intersection (-1 <..< 1) a
+
+positiveIntegralPowersOfNegativeValues
+  :: RealFrac r => Interval r -> Interval r -> Interval r
+positiveIntegralPowersOfNegativeValues a b
+  | null a || null b         = empty
+  | Just ub <- mub, lb > ub  = empty
+  | Just ub <- mub, lb == ub = a ^ lb
+  -- cases below connects two intervals (a ^ k, 0) + (0, a ^ k'))
+  -- into a single convex hull
+  | lowerBound a >= -1       = hull (a ^ lb) (a ^ (lb + 1))
+  | Just ub <- mub           = hull (a ^ ub) (a ^ (ub - 1))
+  | Nothing <- mub           = whole
+  where
+    -- Similar to Data.IntegerInterval.fromIntervalUnder
+    lb :: Integer
+    lb = case lowerBound' b of
+      (Finite x, Open)
+        | fromInteger (ceiling x) == x
+        -> ceiling x + 1
+      (Finite x, _) -> ceiling x
+      _ -> 0 -- PosInf is not expected, because b is not null
+    mub :: Maybe Integer
+    mub = case upperBound' b of
+      (Finite x, Open)
+        | fromInteger (floor x) == x
+        -> Just $ floor x - 1
+      (Finite x, _) -> Just $ floor x
+      _ -> Nothing -- NegInf is not expected, because b is not null
+
+cmpUB, cmpLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
 cmpUB (x1,in1) (x2,in2) = compare x1 x2 `mappend` compare in1 in2
 cmpLB (x1,in1) (x2,in2) = compare x1 x2 `mappend` compare in2 in1
 
-{-# DEPRECATED EndPoint "EndPoint is deprecated. Please use Extended instead." #-}
--- | Endpoints of intervals
-type EndPoint r = Extended r
-
-scaleInf' :: (Num r, Ord r) => r -> (Extended r, Bool) -> (Extended r, Bool)
+scaleInf' :: (Num r, Ord r) => r -> (Extended r, Boundary) -> (Extended r, Boundary)
 scaleInf' a (x1, in1) = (scaleEndPoint a x1, in1)
 
 scaleEndPoint :: (Num r, Ord r) => r -> Extended r -> Extended r
@@ -661,15 +800,61 @@
         Finite b -> Finite (a*b)
         PosInf   -> NegInf
 
-mulInf' :: (Num r, Ord r) => (Extended r, Bool) -> (Extended r, Bool) -> (Extended r, Bool)
-mulInf' (0, True) _ = (0, True)
-mulInf' _ (0, True) = (0, True)
-mulInf' (x1,in1) (x2,in2) = (x1*x2, in1 && in2)
+mulInf' :: (Num r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary) -> (Extended r, Boundary)
+mulInf' (0, Closed) _ = (0, Closed)
+mulInf' _ (0, Closed) = (0, Closed)
+mulInf' (x1,in1) (x2,in2) = (x1*x2, in1 `min` in2)
 
-recipLB :: (Fractional r, Ord r) => (Extended r, Bool) -> (Extended r, Bool)
-recipLB (0, _) = (PosInf, False)
+recipLB :: (Fractional r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary)
+recipLB (0, _) = (PosInf, Open)
 recipLB (x1, in1) = (recip x1, in1)
 
-recipUB :: (Fractional r, Ord r) => (Extended r, Bool) -> (Extended r, Bool)
-recipUB (0, _) = (NegInf, False)
+recipUB :: (Fractional r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary)
+recipUB (0, _) = (NegInf, Open)
 recipUB (x1, in1) = (recip x1, in1)
+
+logB :: (Floating r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary)
+logB (NegInf, in1) = (Finite $ log (log 0), in1)
+logB (Finite 0, _) = (NegInf, Open)
+logB (Finite x1, in1) = (Finite $ log x1, in1)
+logB (PosInf, in1) = (PosInf, in1)
+
+atanhB :: (Floating r, Ord r) => (Extended r, Boundary) -> (Extended r, Boundary)
+atanhB (NegInf, in1) = (Finite $ atanh (-1/0), in1)
+atanhB (Finite (-1), _) = (NegInf, Open)
+atanhB (Finite 1, _) = (PosInf, Open)
+atanhB (Finite x1, in1) = (Finite $ atanh x1, in1)
+atanhB (PosInf, in1) = (Finite $ atanh (1/0), in1)
+
+-- | Computes how two intervals are related according to the @`Data.IntervalRelation.Relation`@ classification
+relate :: Ord r => Interval r -> Interval r -> Relation
+relate i1 i2 =
+  case (i1 `isSubsetOf` i2, i2 `isSubsetOf` i1) of
+    -- 'i1' ad 'i2' are equal
+    (True , True ) -> Equal
+    -- 'i1' is strictly contained in `i2`
+    (True , False) | compareBound (lowerBound' i1) (lowerBound' i2) == EQ -> Starts
+                   | compareBound (upperBound' i1) (upperBound' i2) == EQ -> Finishes
+                   | otherwise                                            -> During
+    -- 'i2' is strictly contained in `i1`
+    (False, True ) | compareBound (lowerBound' i1) (lowerBound' i2) == EQ -> StartedBy
+                   | compareBound (upperBound' i1) (upperBound' i2) == EQ -> FinishedBy
+                   | otherwise                                            -> Contains
+    -- neither `i1` nor `i2` is contained in the other
+    (False, False) -> case ( null (i1 `intersection` i2)
+                           , compareBound (upperBound' i1) (upperBound' i2) <= EQ
+                           , i1 `isConnected` i2
+                           ) of
+      (True , True , True ) -> JustBefore
+      (True , True , False) -> Before
+      (True , False, True ) -> JustAfter
+      (True , False, False) -> After
+      (False, True , _    ) -> Overlaps
+      (False, False, _    ) -> OverlappedBy
+  where
+    compareBound :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
+    compareBound (PosInf, _) (PosInf, _) = EQ
+    compareBound (PosInf, _) _           = GT
+    compareBound (NegInf, _) (NegInf, _) = EQ
+    compareBound (NegInf, _) _           = LT
+    compareBound a           b           = compare a b
diff --git a/src/Data/Interval/Internal.hs b/src/Data/Interval/Internal.hs
--- a/src/Data/Interval/Internal.hs
+++ b/src/Data/Interval/Internal.hs
@@ -1,12 +1,11 @@
 {-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE CPP, DeriveDataTypeable #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric, LambdaCase, ScopedTypeVariables #-}
 {-# LANGUAGE Safe #-}
-#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
-#endif
 
 module Data.Interval.Internal
-  ( Interval
+  ( Boundary(..)
+  , Interval
   , lowerBound'
   , upperBound'
   , interval
@@ -17,20 +16,133 @@
 import Data.Data
 import Data.ExtendedReal
 import Data.Hashable
+import Data.Int
+import Foreign.Marshal.Array
+import Foreign.Ptr
+import Foreign.Storable
+import GHC.Generics (Generic)
 
--- | The intervals (/i.e./ connected and convex subsets) over real numbers __R__.
-data Interval r = Interval
-  { -- | 'lowerBound' of the interval and whether it is included in the interval.
-    -- The result is convenient to use as an argument for 'interval'.
-    lowerBound' :: !(Extended r, Bool)
-  , -- | 'upperBound' of the interval and whether it is included in the interval.
-    -- The result is convenient to use as an argument for 'interval'.
-    upperBound' :: !(Extended r, Bool)
-  } deriving (Eq, Typeable)
+-- | Boundary of an interval may be
+-- open (excluding an endpoint) or closed (including an endpoint).
+--
+-- @since 2.0.0
+data Boundary
+  = Open
+  | Closed
+  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data, Typeable)
 
-#if __GLASGOW_HASKELL__ >= 708
+instance NFData Boundary
+
+instance Hashable Boundary
+
+-- | The intervals (/i.e./ connected and convex subsets) over a type @r@.
+data Interval r
+  = Whole
+  | Empty
+  | Point !r
+  | LessThan !r
+  | LessOrEqual !r
+  | GreaterThan !r
+  | GreaterOrEqual !r
+  -- For constructors below
+  -- the first argument is strictly less than the second one
+  | BothClosed !r !r
+  | LeftOpen !r !r
+  | RightOpen !r !r
+  | BothOpen !r !r
+  deriving
+    ( Eq
+    , Ord
+      -- ^ Note that this Ord is derived and not semantically meaningful.
+      -- The primary intended use case is to allow using 'Interval'
+      -- in maps and sets that require ordering.
+    , Typeable
+    )
+
+peekInterval :: (Applicative m, Monad m, Ord r) => m Int8 -> m r -> m r -> m (Interval r)
+peekInterval tagM x y = do
+  tag <- tagM
+  case tag of
+    0 -> pure Whole
+    1 -> pure Empty
+    2 -> Point           <$> x
+    3 -> LessThan        <$> x
+    4 -> LessOrEqual     <$> x
+    5 -> GreaterThan     <$> x
+    6 -> GreaterOrEqual  <$> x
+    7 -> wrap BothClosed <$> x <*> y
+    8 -> wrap LeftOpen   <$> x <*> y
+    9 -> wrap RightOpen  <$> x <*> y
+    _ -> wrap BothOpen   <$> x <*> y
+
+-- | Enforce the internal invariant
+-- of 'BothClosed' / 'LeftOpen' / 'RightOpen' / 'BothOpen'.
+wrap :: Ord r => (r -> r -> Interval r) -> r -> r -> Interval r
+wrap f x y
+  | x < y = f x y
+  | otherwise = Empty
+
+pokeInterval :: Applicative m => (Int8 -> m ()) -> (r -> m ()) -> (r -> m ()) -> Interval r -> m ()
+pokeInterval tag actX actY = \case
+  Whole            -> tag (0 :: Int8)
+  Empty            -> tag (1 :: Int8)
+  Point          x -> tag (2 :: Int8) *> actX x
+  LessThan       x -> tag (3 :: Int8) *> actX x
+  LessOrEqual    x -> tag (4 :: Int8) *> actX x
+  GreaterThan    x -> tag (5 :: Int8) *> actX x
+  GreaterOrEqual x -> tag (6 :: Int8) *> actX x
+  BothClosed   x y -> tag (7 :: Int8) *> actX x *> actY y
+  LeftOpen     x y -> tag (8 :: Int8) *> actX x *> actY y
+  RightOpen    x y -> tag (9 :: Int8) *> actX x *> actY y
+  BothOpen     x y -> tag (10 :: Int8) *> actX x *> actY y
+
+instance (Storable r, Ord r) => Storable (Interval r) where
+  sizeOf _ = 3 * sizeOf (undefined :: r)
+  alignment _ = alignment (undefined :: r)
+  peek ptr = peekInterval
+    (peek $ castPtr ptr)
+    (peek $ castPtr ptr `advancePtr` 1)
+    (peek $ castPtr ptr `advancePtr` 2)
+  poke ptr = pokeInterval
+    (poke $ castPtr ptr)
+    (poke $ castPtr ptr `advancePtr` 1)
+    (poke $ castPtr ptr `advancePtr` 2)
+
+-- | Lower endpoint (/i.e./ greatest lower bound) of the interval,
+-- together with 'Boundary' information.
+-- The result is convenient to use as an argument for 'interval'.
+lowerBound' :: Interval r -> (Extended r, Boundary)
+lowerBound' = \case
+  Whole            -> (NegInf,   Open)
+  Empty            -> (PosInf,   Open)
+  Point r          -> (Finite r, Closed)
+  LessThan{}       -> (NegInf,   Open)
+  LessOrEqual{}    -> (NegInf,   Open)
+  GreaterThan r    -> (Finite r, Open)
+  GreaterOrEqual r -> (Finite r, Closed)
+  BothClosed p _   -> (Finite p, Closed)
+  LeftOpen p _     -> (Finite p, Open)
+  RightOpen p _    -> (Finite p, Closed)
+  BothOpen p _     -> (Finite p, Open)
+
+-- | Upper endpoint (/i.e./ least upper bound) of the interval,
+-- together with 'Boundary' information.
+-- The result is convenient to use as an argument for 'interval'.
+upperBound' :: Interval r -> (Extended r, Boundary)
+upperBound' = \case
+  Whole            -> (PosInf,   Open)
+  Empty            -> (NegInf,   Open)
+  Point r          -> (Finite r, Closed)
+  LessThan r       -> (Finite r, Open)
+  LessOrEqual r    -> (Finite r, Closed)
+  GreaterThan{}    -> (PosInf,   Open)
+  GreaterOrEqual{} -> (PosInf,   Open)
+  BothClosed _ q   -> (Finite q, Closed)
+  LeftOpen _ q     -> (Finite q, Closed)
+  RightOpen _ q    -> (Finite q, Open)
+  BothOpen _ q     -> (Finite q, Open)
+
 type role Interval nominal
-#endif
 
 instance (Ord r, Data r) => Data (Interval r) where
   gfoldl k z x   = z interval `k` lowerBound' x `k` upperBound' x
@@ -48,27 +160,67 @@
 intervalDataType = mkDataType "Data.Interval.Internal.Interval" [intervalConstr]
 
 instance NFData r => NFData (Interval r) where
-  rnf (Interval lb ub) = rnf lb `seq` rnf ub
+  rnf = \case
+    Whole            -> ()
+    Empty            -> ()
+    Point r          -> rnf r
+    LessThan r       -> rnf r
+    LessOrEqual r    -> rnf r
+    GreaterThan r    -> rnf r
+    GreaterOrEqual r -> rnf r
+    BothClosed p q   -> rnf p `seq` rnf q
+    LeftOpen p q     -> rnf p `seq` rnf q
+    RightOpen p q    -> rnf p `seq` rnf q
+    BothOpen p q     -> rnf p `seq` rnf q
 
 instance Hashable r => Hashable (Interval r) where
-  hashWithSalt s (Interval lb ub) = s `hashWithSalt` lb `hashWithSalt` ub
+  hashWithSalt s = \case
+    Whole            -> s `hashWithSalt`  (1 :: Int)
+    Empty            -> s `hashWithSalt`  (2 :: Int)
+    Point r          -> s `hashWithSalt`  (3 :: Int) `hashWithSalt` r
+    LessThan r       -> s `hashWithSalt`  (4 :: Int) `hashWithSalt` r
+    LessOrEqual r    -> s `hashWithSalt`  (5 :: Int) `hashWithSalt` r
+    GreaterThan r    -> s `hashWithSalt`  (6 :: Int) `hashWithSalt` r
+    GreaterOrEqual r -> s `hashWithSalt`  (7 :: Int) `hashWithSalt` r
+    BothClosed p q   -> s `hashWithSalt`  (8 :: Int) `hashWithSalt` p `hashWithSalt` q
+    LeftOpen p q     -> s `hashWithSalt`  (9 :: Int) `hashWithSalt` p `hashWithSalt` q
+    RightOpen p q    -> s `hashWithSalt` (10 :: Int) `hashWithSalt` p `hashWithSalt` q
+    BothOpen p q     -> s `hashWithSalt` (11 :: Int) `hashWithSalt` p `hashWithSalt` q
 
 -- | empty (contradicting) interval
 empty :: Ord r => Interval r
-empty = Interval (PosInf, False) (NegInf, False)
+empty = Empty
 
 -- | smart constructor for 'Interval'
 interval
   :: (Ord r)
-  => (Extended r, Bool) -- ^ lower bound and whether it is included
-  -> (Extended r, Bool) -- ^ upper bound and whether it is included
+  => (Extended r, Boundary) -- ^ lower bound and whether it is included
+  -> (Extended r, Boundary) -- ^ upper bound and whether it is included
   -> Interval r
-interval lb@(x1,in1) ub@(x2,in2) =
-  case x1 `compare` x2 of
-    GT -> empty --  empty interval
-    LT -> Interval (normalize lb) (normalize ub)
-    EQ -> if in1 && in2 && isFinite x1 then Interval lb ub else empty
-  where
-    normalize x@(Finite _, _) = x
-    normalize (x, _) = (x, False)
-
+interval = \case
+  (NegInf, _) -> \case
+    (NegInf, _) -> Empty
+    (Finite r, Open) -> LessThan r
+    (Finite r, Closed) -> LessOrEqual r
+    (PosInf, _) -> Whole
+  (Finite p, Open) -> \case
+    (NegInf, _) -> Empty
+    (Finite q, Open)
+      | p < q -> BothOpen p q
+      | otherwise -> Empty
+    (Finite q, Closed)
+      | p < q -> LeftOpen p q
+      | otherwise -> Empty
+    (PosInf, _) -> GreaterThan p
+  (Finite p, Closed) -> \case
+    (NegInf, _) -> Empty
+    (Finite q, Open)
+      | p < q -> RightOpen p q
+      | otherwise -> Empty
+    (Finite q, Closed) -> case p `compare` q of
+      LT -> BothClosed p q
+      EQ -> Point p
+      GT -> Empty
+    (PosInf, _) -> GreaterOrEqual p
+  (PosInf, _) -> const Empty
+{-# INLINE interval #-}
diff --git a/src/Data/IntervalMap/Base.hs b/src/Data/IntervalMap/Base.hs
--- a/src/Data/IntervalMap/Base.hs
+++ b/src/Data/IntervalMap/Base.hs
@@ -1,9 +1,7 @@
 {-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE CPP, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf, GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE Trustworthy #-}
-#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
-#endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.IntervalMap.Base
@@ -22,7 +20,6 @@
   -- * IntervalMap type
     IntervalMap (..)
   , module Data.ExtendedReal
-  , EndPoint
 
   -- * Operators
   , (!)
@@ -91,29 +88,24 @@
   )
   where
 
-import Prelude hiding (null, lookup, map, filter, span)
-import Control.Applicative hiding (empty)
+import Prelude hiding (null, lookup, map, filter, span, and)
 import Control.DeepSeq
-import Control.Monad
 import Data.Data
-import Data.Foldable hiding (null, foldl', and, toList)
 import Data.ExtendedReal
 import Data.Hashable
-import Data.List (foldl')
+import Data.Foldable hiding (null, toList)
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
-import Data.Monoid
-import Data.Semigroup (Semigroup)
 import qualified Data.Semigroup as Semigroup
-import Data.Traversable
-import Data.Interval (Interval, EndPoint)
+import Data.Interval (Interval)
 import qualified Data.Interval as Interval
 import Data.IntervalSet (IntervalSet)
 import qualified Data.IntervalSet as IntervalSet
-#if __GLASGOW_HASKELL__ >= 708
-import qualified GHC.Exts as GHCExts
+#if __GLASGOW_HASKELL__ < 804
+import Data.Monoid (Monoid(..))
 #endif
+import qualified GHC.Exts as GHCExts
 
 -- ------------------------------------------------------------------------
 -- The IntervalMap type
@@ -123,11 +115,16 @@
 -- Unlike 'IntervalSet', 'IntervalMap' never merge adjacent mappings,
 -- even if adjacent intervals are connected and mapped to the same value.
 newtype IntervalMap r a = IntervalMap (Map (LB r) (Interval r, a))
-  deriving (Eq, Typeable)
+  deriving
+    ( Eq
+    , Ord
+      -- ^ Note that this Ord is derived and not semantically meaningful.
+      -- The primary intended use case is to allow using 'IntervalSet'
+      -- in maps and sets that require ordering.
+    , Typeable
+    )
 
-#if __GLASGOW_HASKELL__ >= 708
 type role IntervalMap nominal representational
-#endif
 
 instance (Ord k, Show k, Show a) => Show (IntervalMap k a) where
   showsPrec p (IntervalMap m) = showParen (p > appPrec) $
@@ -170,31 +167,21 @@
 
 instance Ord k => Monoid (IntervalMap k a) where
   mempty = empty
-  mappend = union
+  mappend = (Semigroup.<>)
   mconcat = unions
 
-instance Ord k => Semigroup (IntervalMap k a) where
+instance Ord k => Semigroup.Semigroup (IntervalMap k a) where
   (<>)   = union
-#if !defined(VERSION_semigroups)
   stimes = Semigroup.stimesIdempotentMonoid
-#else
-#if MIN_VERSION_semigroups(0,17,0)
-  stimes = Semigroup.stimesIdempotentMonoid
-#else
-  times1p _ a = a
-#endif
-#endif
 
-#if __GLASGOW_HASKELL__ >= 708
 instance Ord k => GHCExts.IsList (IntervalMap k a) where
   type Item (IntervalMap k a) = (Interval k, a)
   fromList = fromList
   toList = toList
-#endif
 
 -- ------------------------------------------------------------------------
 
-newtype LB r = LB (Extended r, Bool)
+newtype LB r = LB (Extended r, Interval.Boundary)
   deriving (Eq, NFData, Typeable)
 
 instance Ord r => Ord (LB r) where
@@ -210,7 +197,7 @@
 -- | Find the value at a key. Calls 'error' when the element can not be found.
 (!) :: Ord k => IntervalMap k a -> k -> a
 IntervalMap m ! k =
-  case Map.lookupLE (LB (Finite k, True)) m of
+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of
     Just (_, (i, a)) | k `Interval.member` i -> a
     _ -> error "IntervalMap.!: given key is not an element in the map"
 
@@ -228,7 +215,7 @@
 -- | Is the key a member of the map? See also 'notMember'.
 member :: Ord k => k -> IntervalMap k a -> Bool
 member k (IntervalMap m) =
-  case Map.lookupLE (LB (Finite k, True)) m of
+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of
     Just (_, (i, _)) -> k `Interval.member` i
     Nothing -> False
 
@@ -242,7 +229,7 @@
 -- or 'Nothing' if the key isn't in the map.
 lookup :: Ord k => k -> IntervalMap k a -> Maybe a
 lookup k (IntervalMap m) =
-  case Map.lookupLE (LB (Finite k, True)) m of
+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of
     Just (_, (i, a)) | k `Interval.member` i -> Just a
     _ -> Nothing
 
@@ -251,7 +238,7 @@
 -- when the key is not in the map.
 findWithDefault :: Ord k => a -> k -> IntervalMap k a -> a
 findWithDefault def k (IntervalMap m) =
-  case Map.lookupLE (LB (Finite k, True)) m of
+  case Map.lookupLE (LB (Finite k, Interval.Closed)) m of
     Just (_, (i, a)) | k `Interval.member` i -> a
     _ -> def
 
@@ -312,7 +299,7 @@
 -- ------------------------------------------------------------------------
 -- Delete/Update
 
--- | Delete an interval and its value from the map. 
+-- | Delete an interval and its value from the map.
 -- When the interval does not overlap with the map, the original map is returned.
 delete :: Ord k => Interval k -> IntervalMap k a -> IntervalMap k a
 delete i m | Interval.null i = m
@@ -324,7 +311,7 @@
 -- | Update a value at a specific interval with the result of the provided function.
 -- When the interval does not overlatp with the map, the original map is returned.
 adjust :: Ord k => (a -> a) -> Interval k -> IntervalMap k a -> IntervalMap k a
-adjust f = update (Just . f)  
+adjust f = update (Just . f)
 
 -- | The expression (@'update' f i map@) updates the value @x@
 -- at @i@ (if it is in the map). If (@f x@) is 'Nothing', the element is
@@ -334,7 +321,7 @@
 update f i m =
   case split i m of
     (IntervalMap m1, IntervalMap m2, IntervalMap m3) ->
-      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(i,a) -> (\b -> (i,b)) <$> f a) m2, m3]
+      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(j,a) -> (\b -> (j,b)) <$> f a) m2, m3]
 
 -- | The expression (@'alter' f i map@) alters the value @x@ at @i@, or absence thereof.
 -- 'alter' can be used to insert, delete, or update a value in a 'IntervalMap'.
@@ -357,12 +344,12 @@
 -- | The expression (@'union' t1 t2@) takes the left-biased union of @t1@ and @t2@.
 -- It prefers @t1@ when overlapping keys are encountered,
 union :: Ord k => IntervalMap k a -> IntervalMap k a -> IntervalMap k a
-union m1 m2 = 
+union m1 m2 =
   foldl' (\m (i,a) -> insert i a m) m2 (toList m1)
 
 -- | Union with a combining function.
 unionWith :: Ord k => (a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
-unionWith f m1 m2 = 
+unionWith f m1 m2 =
   foldl' (\m (i,a) -> insertWith f i a m) m2 (toList m1)
 
 -- | The union of a list of maps:
@@ -385,19 +372,19 @@
 intersection = intersectionWith const
 
 -- | Intersection with a combining function.
-intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c 
+intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
 intersectionWith f im1@(IntervalMap m1) im2@(IntervalMap m2)
   | Map.size m1 >= Map.size m2 = g f im1 im2
   | otherwise = g (flip f) im2 im1
   where
-    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c 
-    g f im1 (IntervalMap m2) = IntervalMap $ Map.unions $ go im1 (Map.elems m2)
+    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
+    g h jm1 (IntervalMap m3) = IntervalMap $ Map.unions $ go jm1 (Map.elems m3)
       where
         go _ [] = []
         go im ((i,b) : xs) =
           case split i im of
-            (_, IntervalMap m, im2) ->
-              Map.map (\(j, a) -> (j, f a b)) m : go im2 xs
+            (_, IntervalMap m, jm2) ->
+              Map.map (\(j, a) -> (j, h a b)) m : go jm2 xs
 
 -- ------------------------------------------------------------------------
 -- Traversal
@@ -415,7 +402,7 @@
 map :: (a -> b) -> IntervalMap k a -> IntervalMap k b
 map f (IntervalMap m) = IntervalMap $ Map.map (\(i, a) -> (i, f a)) m
 
--- | @'mapKeys' f s@ is the map obtained by applying @f@ to each key of @s@.
+-- | @'mapKeysMonotonic' f s@ is the map obtained by applying @f@ to each key of @s@.
 -- @f@ must be strictly monotonic.
 -- That is, for any values @x@ and @y@, if @x@ < @y@ then @f x@ < @f y@.
 mapKeysMonotonic :: forall k1 k2 a. (Ord k1, Ord k2) => (k1 -> k2) -> IntervalMap k1 a -> IntervalMap k2 a
@@ -435,7 +422,7 @@
 keys (IntervalMap m) = [i | (i,_) <- Map.elems m]
 
 -- | An alias for 'toAscList'. Return all key\/value pairs in the map
--- in ascending key order. 
+-- in ascending key order.
 assocs :: IntervalMap k a -> [(Interval k, a)]
 assocs = toAscList
 
@@ -443,15 +430,15 @@
 keysSet :: Ord k => IntervalMap k a -> IntervalSet k
 keysSet (IntervalMap m) = IntervalSet.fromAscList [i | (i,_) <- Map.elems m]
 
--- | Convert the map to a list of key\/value pairs. 
+-- | Convert the map to a list of key\/value pairs.
 toList :: IntervalMap k a -> [(Interval k, a)]
 toList = toAscList
 
--- | Convert the map to a list of key/value pairs where the keys are in ascending order. 
+-- | Convert the map to a list of key/value pairs where the keys are in ascending order.
 toAscList :: IntervalMap k a -> [(Interval k, a)]
 toAscList (IntervalMap m) = Map.elems m
 
--- | Convert the map to a list of key/value pairs where the keys are in descending order. 
+-- | Convert the map to a list of key/value pairs where the keys are in descending order.
 toDescList :: IntervalMap k a -> [(Interval k, a)]
 toDescList (IntervalMap m) = fmap snd $ Map.toDescList m
 
@@ -477,8 +464,8 @@
 split :: Ord k => Interval k -> IntervalMap k a -> (IntervalMap k a, IntervalMap k a, IntervalMap k a)
 split i (IntervalMap m) =
   case splitLookupLE (LB (Interval.lowerBound' i)) m of
-    (smaller, m1, xs) -> 
-      case splitLookupLE (LB (Interval.upperBound i, True)) xs of
+    (smaller, m1, xs) ->
+      case splitLookupLE (LB (Interval.upperBound i, Interval.Closed)) xs of
         (middle, m2, larger) ->
           ( IntervalMap $
               case m1 of
@@ -500,7 +487,7 @@
               , let k = Interval.intersection (downTo i) j
               , not (Interval.null k)
               ]
-          ) 
+          )
 
 -- ------------------------------------------------------------------------
 -- Submap
@@ -511,7 +498,7 @@
 
 -- |  The expression (@'isSubmapOfBy' f t1 t2@) returns 'True' if
 -- all keys in @t1@ are in tree @t2@, and when @f@ returns 'True' when
--- applied to their respective values. 
+-- applied to their respective values.
 isSubmapOfBy :: Ord k => (a -> b -> Bool) -> IntervalMap k a -> IntervalMap k b -> Bool
 isSubmapOfBy f m1 m2 = and $
   [ case lookupInterval i m2 of
@@ -551,7 +538,7 @@
     (NegInf, _) -> Interval.empty
     (PosInf, _) -> Interval.whole
     (Finite lb, incl) ->
-      Interval.interval (NegInf,False) (Finite lb, not incl)
+      Interval.interval (NegInf, Interval.Open) (Finite lb, notB incl)
 
 downTo :: Ord r => Interval r -> Interval r
 downTo i =
@@ -559,4 +546,9 @@
     (PosInf, _) -> Interval.empty
     (NegInf, _) -> Interval.whole
     (Finite ub, incl) ->
-      Interval.interval (Finite ub, not incl) (PosInf,False)
+      Interval.interval (Finite ub, notB incl) (PosInf, Interval.Open)
+
+notB :: Interval.Boundary -> Interval.Boundary
+notB = \case
+  Interval.Open   -> Interval.Closed
+  Interval.Closed -> Interval.Open
diff --git a/src/Data/IntervalMap/Lazy.hs b/src/Data/IntervalMap/Lazy.hs
--- a/src/Data/IntervalMap/Lazy.hs
+++ b/src/Data/IntervalMap/Lazy.hs
@@ -33,7 +33,6 @@
   -- * IntervalMap type
     IntervalMap
   , module Data.ExtendedReal
-  , EndPoint
 
   -- * Operators
   , (!)
diff --git a/src/Data/IntervalMap/Strict.hs b/src/Data/IntervalMap/Strict.hs
--- a/src/Data/IntervalMap/Strict.hs
+++ b/src/Data/IntervalMap/Strict.hs
@@ -1,5 +1,5 @@
 {-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE CPP, BangPatterns, TupleSections #-}
+{-# LANGUAGE BangPatterns, TupleSections #-}
 {-# LANGUAGE Safe #-}
 -----------------------------------------------------------------------------
 -- |
@@ -34,7 +34,6 @@
   -- * IntervalMap type
     IntervalMap
   , module Data.ExtendedReal
-  , EndPoint
 
   -- * Operators
   , (!)
@@ -105,9 +104,8 @@
 
 
 import Prelude hiding (null, lookup, map, filter, span)
-import Control.Applicative hiding (empty)
 import Data.ExtendedReal
-import Data.Interval (Interval, EndPoint)
+import Data.Interval (Interval)
 import qualified Data.Interval as Interval
 import Data.IntervalMap.Base hiding
   ( whole
@@ -185,7 +183,7 @@
 update f i m =
   case split i m of
     (IntervalMap m1, IntervalMap m2, IntervalMap m3) ->
-      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(i,a) -> (\b -> seq b (i,b)) <$> f a) m2, m3]
+      IntervalMap $ Map.unions [m1, Map.mapMaybe (\(j,a) -> (\b -> seq b (j,b)) <$> f a) m2, m3]
 
 -- | The expression (@'alter' f i map@) alters the value @x@ at @i@, or absence thereof.
 -- 'alter' can be used to insert, delete, or update a value in a 'IntervalMap'.
@@ -207,7 +205,7 @@
 
 -- | Union with a combining function.
 unionWith :: Ord k => (a -> a -> a) -> IntervalMap k a -> IntervalMap k a -> IntervalMap k a
-unionWith f m1 m2 = 
+unionWith f m1 m2 =
   foldl' (\m (i,a) -> insertWith f i a m) m2 (toList m1)
 
 -- | The union of a list of maps, with a combining operation:
@@ -216,19 +214,19 @@
 unionsWith f = foldl' (unionWith f) empty
 
 -- | Intersection with a combining function.
-intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c 
+intersectionWith :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
 intersectionWith f im1@(IntervalMap m1) im2@(IntervalMap m2)
   | Map.size m1 >= Map.size m2 = g f im1 im2
   | otherwise = g (flip f) im2 im1
   where
-    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c 
-    g f im1 (IntervalMap m2) = IntervalMap $ Map.unions $ go im1 (Map.elems m2)
+    g :: Ord k => (a -> b -> c) -> IntervalMap k a -> IntervalMap k b -> IntervalMap k c
+    g h jm1 (IntervalMap m3) = IntervalMap $ Map.unions $ go jm1 (Map.elems m3)
       where
         go _ [] = []
         go im ((i,b) : xs) =
           case split i im of
-            (_, IntervalMap m, im2) ->
-              Map.map (\(j, a) -> (j,) $! f a b) m : go im2 xs
+            (_, IntervalMap m, jm2) ->
+              Map.map (\(j, a) -> (j,) $! h a b) m : go jm2 xs
 
 -- ------------------------------------------------------------------------
 -- Traversal
diff --git a/src/Data/IntervalRelation.hs b/src/Data/IntervalRelation.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/IntervalRelation.hs
@@ -0,0 +1,82 @@
+{-# OPTIONS_GHC -Wall #-}
+{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE Safe #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module      :  Data.IntervalRelation
+-- Copyright   :  (c) Masahiro Sakai 2016
+-- License     :  BSD-style
+--
+-- Maintainer  :  masahiro.sakai@gmail.com
+-- Stability   :  provisional
+-- Portability :  non-portable (CPP, DeriveDataTypeable, DeriveGeneric)
+--
+-- Interval relations and their algebra.
+--
+-----------------------------------------------------------------------------
+module Data.IntervalRelation
+  ( Relation(..)
+  , invert
+  )
+  where
+
+import Data.Data
+import GHC.Generics (Generic)
+
+-- | Describes how two intervals @x@ and @y@ can be related.
+-- See [Allen's interval algebra](https://en.wikipedia.org/wiki/Allen%27s_interval_algebra)
+-- and [Intervals and their relations](http://marcosh.github.io/post/2020/05/04/intervals-and-their-relations.html).
+data Relation
+  = Before
+  -- ^ Any element of @x@ is smaller than any element of @y@,
+  -- and intervals are not connected. In other words, there exists an element
+  -- that is bigger than any element of @x@ and smaller than any element of @y@.
+  | JustBefore
+  -- ^ Any element of @x@ is smaller than any element of @y@,
+  -- but intervals are connected and non-empty. This implies that intersection
+  -- of intervals is empty, and union is a single interval.
+  | Overlaps
+  -- ^ Intersection of @x@ and @y@ is non-empty,
+  -- @x@ start and finishes earlier than @y@. This implies that union
+  -- is a single interval, and @x@ finishes no earlier than @y@ starts.
+  | Starts
+  -- ^ @x@ is a proper subset of @y@,
+  -- and they share lower bounds.
+  | During
+  -- ^ @x@ is a proper subset of @y@,
+  -- but they share neither lower nor upper bounds.
+  | Finishes
+  -- ^ @x@ is a proper subset of @y@,
+  -- and they share upper bounds.
+  | Equal
+  -- ^ Intervals are equal.
+  | FinishedBy
+  -- ^ Inverse of 'Finishes'.
+  | Contains
+  -- ^ Inverse of 'During'.
+  | StartedBy
+  -- ^ Inverse of 'Starts'.
+  | OverlappedBy
+  -- ^ Inverse of 'Overlaps'.
+  | JustAfter
+  -- ^ Inverse of 'JustBefore'.
+  | After
+  -- ^ Inverse of 'Before'.
+  deriving (Eq, Ord, Enum, Bounded, Show, Read, Generic, Data, Typeable)
+
+-- | Inverts a relation, such that @'invert' ('Data.Interval.relate' x y) = 'Data.Interval.relate' y x@
+invert :: Relation -> Relation
+invert relation = case relation of
+  Before       -> After
+  JustBefore   -> JustAfter
+  Overlaps     -> OverlappedBy
+  Starts       -> StartedBy
+  During       -> Contains
+  Finishes     -> FinishedBy
+  Equal        -> Equal
+  FinishedBy   -> Finishes
+  Contains     -> During
+  StartedBy    -> Starts
+  OverlappedBy -> Overlaps
+  JustAfter    -> JustBefore
+  After        -> Before
diff --git a/src/Data/IntervalSet.hs b/src/Data/IntervalSet.hs
--- a/src/Data/IntervalSet.hs
+++ b/src/Data/IntervalSet.hs
@@ -1,9 +1,7 @@
 {-# OPTIONS_GHC -Wall #-}
-{-# LANGUAGE CPP, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-}
+{-# LANGUAGE CPP, LambdaCase, ScopedTypeVariables, TypeFamilies, DeriveDataTypeable, MultiWayIf #-}
 {-# LANGUAGE Trustworthy #-}
-#if __GLASGOW_HASKELL__ >= 708
 {-# LANGUAGE RoleAnnotations #-}
-#endif
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  Data.IntervalSet
@@ -22,7 +20,6 @@
   -- * IntervalSet type
     IntervalSet
   , module Data.ExtendedReal
-  , EndPoint
 
   -- * Construction
   , whole
@@ -63,7 +60,9 @@
   where
 
 import Prelude hiding (null, span)
+#ifdef MIN_VERSION_lattices
 import Algebra.Lattice
+#endif
 import Control.DeepSeq
 import Data.Data
 import Data.ExtendedReal
@@ -73,24 +72,28 @@
 import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Maybe
-import Data.Monoid
-import Data.Semigroup (Semigroup)
 import qualified Data.Semigroup as Semigroup
-import Data.Interval (Interval, EndPoint)
+import Data.Interval (Interval, Boundary(..))
 import qualified Data.Interval as Interval
-#if __GLASGOW_HASKELL__ >= 708
-import qualified GHC.Exts as GHCExts
+#if __GLASGOW_HASKELL__ < 804
+import Data.Monoid (Monoid(..))
 #endif
+import qualified GHC.Exts as GHCExts
 
 -- | A set comprising zero or more non-empty, /disconnected/ intervals.
 --
 -- Any connected intervals are merged together, and empty intervals are ignored.
 newtype IntervalSet r = IntervalSet (Map (Extended r) (Interval r))
-  deriving (Eq, Typeable)
+  deriving
+    ( Eq
+    , Ord
+      -- ^ Note that this Ord is derived and not semantically meaningful.
+      -- The primary intended use case is to allow using 'IntervalSet'
+      -- in maps and sets that require ordering.
+    , Typeable
+    )
 
-#if __GLASGOW_HASKELL__ >= 708
 type role IntervalSet nominal
-#endif
 
 instance (Ord r, Show r) => Show (IntervalSet r) where
   showsPrec p (IntervalSet m) = showParen (p > appPrec) $
@@ -131,8 +134,7 @@
 instance Hashable r => Hashable (IntervalSet r) where
   hashWithSalt s (IntervalSet m) = hashWithSalt s (Map.toList m)
 
-#if MIN_VERSION_lattices(2,0,0)
-
+#ifdef MIN_VERSION_lattices
 instance (Ord r) => Lattice (IntervalSet r) where
   (\/) = union
   (/\) = intersection
@@ -142,43 +144,16 @@
 
 instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where
   top = whole
-
-#else
-
-instance (Ord r) => JoinSemiLattice (IntervalSet r) where
-  join = union
-
-instance (Ord r) => MeetSemiLattice (IntervalSet r) where
-  meet = intersection
-
-instance (Ord r) => Lattice (IntervalSet r)
-
-instance (Ord r) => BoundedJoinSemiLattice (IntervalSet r) where
-  bottom = empty
-
-instance (Ord r) => BoundedMeetSemiLattice (IntervalSet r) where
-  top = whole
-
-instance (Ord r) => BoundedLattice (IntervalSet r)
-
 #endif
 
 instance Ord r => Monoid (IntervalSet r) where
   mempty = empty
-  mappend = union
+  mappend = (Semigroup.<>)
   mconcat = unions
 
-instance (Ord r) => Semigroup (IntervalSet r) where
+instance (Ord r) => Semigroup.Semigroup (IntervalSet r) where
   (<>)    = union
-#if !defined(VERSION_semigroups)
   stimes  = Semigroup.stimesIdempotentMonoid
-#else
-#if MIN_VERSION_semigroups(0,17,0)
-  stimes  = Semigroup.stimesIdempotentMonoid
-#else
-  times1p _ a = a
-#endif
-#endif
 
 lift1
   :: Ord r => (Interval r -> Interval r)
@@ -216,16 +191,15 @@
       ]
     return y
 
+-- | @recip (recip xs) == delete 0 xs@
 instance forall r. (Real r, Fractional r) => Fractional (IntervalSet r) where
   fromRational r = singleton (fromRational r)
-  recip = lift1 recip
+  recip xs = lift1 recip (delete (Interval.singleton 0) xs)
 
-#if __GLASGOW_HASKELL__ >= 708
 instance Ord r => GHCExts.IsList (IntervalSet r) where
   type Item (IntervalSet r) = Interval r
   fromList = fromList
   toList = toList
-#endif
 
 -- -----------------------------------------------------------------------
 
@@ -289,29 +263,35 @@
 
 -- | Complement the interval set.
 complement :: Ord r => IntervalSet r -> IntervalSet r
-complement (IntervalSet m) = fromAscList $ f (NegInf,False) (Map.elems m)
+complement (IntervalSet m) = fromAscList $ f (NegInf,Open) (Map.elems m)
   where
-    f prev [] = [ Interval.interval prev (PosInf,False) ]
+    f prev [] = [ Interval.interval prev (PosInf,Open) ]
     f prev (i : is) =
       case (Interval.lowerBound' i, Interval.upperBound' i) of
         ((lb, in1), (ub, in2)) ->
-          Interval.interval prev (lb, not in1) : f (ub, not in2) is
+          Interval.interval prev (lb, notB in1) : f (ub, notB in2) is
 
 -- | Insert a new interval into the interval set.
 insert :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
 insert i is | Interval.null i = is
-insert i (IntervalSet is) = IntervalSet $
-  case splitLookupLE (Interval.lowerBound i) is of
-    (smaller, m1, xs) ->
-      case splitLookupLE (Interval.upperBound i) xs of
-        (_, m2, larger) ->
-          Map.unions
-          [ smaller
-          , case fromList $ i : maybeToList m1 ++ maybeToList m2 of
-              IntervalSet m -> m
-          , larger
-          ]
+insert i (IntervalSet is) = IntervalSet $ Map.unions
+  [ smaller'
+  , case fromList $ i : maybeToList m0 ++ maybeToList m1 ++ maybeToList m2 of
+      IntervalSet m -> m
+  , larger
+  ]
+  where
+    (smaller, m1, xs) = splitLookupLE (Interval.lowerBound i) is
+    (_, m2, larger) = splitLookupLE (Interval.upperBound i) xs
 
+    -- A tricky case is when an interval @i@ connects two adjacent
+    -- members of IntervalSet, e. g., inserting {0} into (whole \\ {0}).
+    (smaller', m0) = case Map.maxView smaller of
+      Nothing -> (smaller, Nothing)
+      Just (v, rest)
+        | Interval.isConnected v i -> (rest, Just v)
+      _ -> (smaller, Nothing)
+
 -- | Delete an interval from the interval set.
 delete :: Ord r => Interval r -> IntervalSet r -> IntervalSet r
 delete i is | Interval.null i = is
@@ -365,7 +345,7 @@
 fromList :: Ord r => [Interval r] -> IntervalSet r
 fromList = IntervalSet . fromAscList' . sortBy (compareLB `on` Interval.lowerBound')
 
--- | Build a map from an ascending list of intervals. 
+-- | Build a map from an ascending list of intervals.
 -- /The precondition is not checked./
 fromAscList :: Ord r => [Interval r] -> IntervalSet r
 fromAscList = IntervalSet . fromAscList'
@@ -398,25 +378,13 @@
 
 splitLookupLE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
 splitLookupLE k m =
-  case Map.splitLookup k m of
-    (smaller, Just v, larger) -> (smaller, Just v, larger)
-    (smaller, Nothing, larger) ->
-      case Map.maxView smaller of
-        Just (v, smaller') -> (smaller', Just v, larger)
-        Nothing -> (smaller, Nothing, larger)
-
-{-
-splitLookupGE :: Ord k => k -> Map k v -> (Map k v, Maybe v, Map k v)
-splitLookupGE k m =
-  case Map.splitLookup k m of
-    (smaller, Just v, larger) -> (smaller, Just v, larger)
-    (smaller, Nothing, larger) ->
-      case Map.minView larger of
-        Just (v, larger') -> (smaller, Just v, larger')
-        Nothing -> (smaller, Nothing, larger)
--}
+  case Map.spanAntitone (<= k) m of
+    (lessOrEqual, greaterThan) ->
+      case Map.maxView lessOrEqual of
+        Just (v, lessOrEqual') -> (lessOrEqual', Just v, greaterThan)
+        Nothing -> (lessOrEqual, Nothing, greaterThan)
 
-compareLB :: Ord r => (Extended r, Bool) -> (Extended r, Bool) -> Ordering
+compareLB :: Ord r => (Extended r, Boundary) -> (Extended r, Boundary) -> Ordering
 compareLB (lb1, lb1in) (lb2, lb2in) =
   -- inclusive lower endpoint shuold be considered smaller
   (lb1 `compare` lb2) `mappend` (lb2in `compare` lb1in)
@@ -427,7 +395,7 @@
     (NegInf, _) -> Interval.empty
     (PosInf, _) -> Interval.whole
     (Finite lb, incl) ->
-      Interval.interval (NegInf,False) (Finite lb, not incl)
+      Interval.interval (NegInf, Open) (Finite lb, notB incl)
 
 downTo :: Ord r => Interval r -> Interval r
 downTo i =
@@ -435,4 +403,9 @@
     (PosInf, _) -> Interval.empty
     (NegInf, _) -> Interval.whole
     (Finite ub, incl) ->
-      Interval.interval (Finite ub, not incl) (PosInf,False)
+      Interval.interval (Finite ub, notB incl) (PosInf, Open)
+
+notB :: Boundary -> Boundary
+notB = \case
+  Open   -> Closed
+  Closed -> Open
diff --git a/test/TestInstances.hs b/test/TestInstances.hs
new file mode 100644
--- /dev/null
+++ b/test/TestInstances.hs
@@ -0,0 +1,47 @@
+module TestInstances where
+
+import Control.Monad
+
+import Test.Tasty.QuickCheck
+
+import Data.Interval
+import Data.IntervalRelation
+
+instance Arbitrary Boundary where
+  arbitrary = arbitraryBoundedEnum
+
+instance Arbitrary r => Arbitrary (Extended r) where
+  arbitrary = frequency
+    [ (1, return NegInf)
+    , (1, return PosInf)
+    , (3, liftM Finite arbitrary)
+    ]
+  shrink NegInf = []
+  shrink (Finite x) = NegInf : PosInf : map Finite (shrink x)
+  shrink PosInf = []
+
+instance (Arbitrary r, Ord r) => Arbitrary (Interval r) where
+  arbitrary = do
+    x <- arbitrary
+    y <- arbitrary
+    frequency
+      [ (1, return $ interval x y)
+      , (3, return $ interval (min x y) (max x y))
+      ]
+  shrink a
+    | isSingleton a = case lowerBound a of
+      Finite x -> map singleton $ shrink x
+      _ -> []
+    | otherwise = mkPoint lb ++ mkPoint ub ++ map (lb `interval`) (shrink ub) ++ map (`interval` ub) (shrink lb)
+    where
+      lb = lowerBound' a
+      ub = upperBound' a
+
+      mkPoint (Finite x, _) = [singleton x]
+      mkPoint _ = []
+
+intervals :: Gen (Interval Rational)
+intervals = arbitrary
+
+instance Arbitrary Relation where
+  arbitrary = arbitraryBoundedEnum
diff --git a/test/TestIntegerInterval.hs b/test/TestIntegerInterval.hs
--- a/test/TestIntegerInterval.hs
+++ b/test/TestIntegerInterval.hs
@@ -1,7 +1,9 @@
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, TemplateHaskell, ScopedTypeVariables #-}
 module TestIntegerInterval (integerIntervalTestGroup) where
 
+#ifdef MIN_VERSION_lattices
 import qualified Algebra.Lattice as L
+#endif
 import Control.DeepSeq
 import Control.Monad
 import Data.Generics.Schemes
@@ -24,6 +26,7 @@
 import qualified Data.IntegerInterval as IntegerInterval
 import Data.Interval (Interval)
 import qualified Data.Interval as Interval
+import Data.IntervalRelation
 
 {--------------------------------------------------------------------
   empty
@@ -228,6 +231,19 @@
 case_isProperSubsetOf =
   (0 <=..<= 1) `IntegerInterval.isProperSubsetOf` (0 <=..<= 2) @?= True
 
+{-- -----------------------------------------------------------------
+  isConnected
+----------------------------------------------------------------- --}
+
+prop_isConnected_reflexive =
+  forAll integerIntervals $ \a ->
+    a `IntegerInterval.isConnected` a
+
+prop_isConnected_symmetric =
+  forAll integerIntervals $ \a ->
+    forAll integerIntervals $ \b ->
+      (a `IntegerInterval.isConnected` b) == (b `IntegerInterval.isConnected` a)
+
 {--------------------------------------------------------------------
   simplestIntegerWithin
 --------------------------------------------------------------------}
@@ -252,11 +268,28 @@
 case_width_null =
   IntegerInterval.width IntegerInterval.empty @?= 0
 
+case_width_positive =
+  IntegerInterval.width (0 <=..< 10) @?= 9
+
 prop_width_singleton =
   forAll arbitrary $ \x ->
     IntegerInterval.width (IntegerInterval.singleton x) == 0
 
 {--------------------------------------------------------------------
+  memberCount
+--------------------------------------------------------------------}
+
+case_memberCount_null =
+  IntegerInterval.memberCount IntegerInterval.empty @?= Just 0
+
+case_memberCount_positive =
+  IntegerInterval.memberCount (0 <=..< 10) @?= Just 10
+
+prop_memberCount_singleton =
+  forAll arbitrary $ \x ->
+    IntegerInterval.memberCount (IntegerInterval.singleton x) == Just 1
+
+{--------------------------------------------------------------------
   map
 --------------------------------------------------------------------}
 
@@ -284,6 +317,43 @@
     IntegerInterval.pickup (IntegerInterval.singleton x) == Just x
 
 {--------------------------------------------------------------------
+  relate
+--------------------------------------------------------------------}
+
+prop_relate_equals =
+  forAll integerIntervals $ \a ->
+    IntegerInterval.relate a a == Equal
+
+prop_relate_empty_contained_in_non_empty =
+  forAll (integerIntervals `suchThat` (not . IntegerInterval.null)) $ \a ->
+    IntegerInterval.relate a IntegerInterval.empty == Contains
+
+prop_relate_detects_before =
+  forAll (nonEmptyIntegerIntervalPairs (\_ ub1 lb2 _ -> ub1 < lb2 - 1)) $ \(a, b) ->
+    IntegerInterval.relate a b == Before
+
+prop_relate_detects_just_before =
+  forAll (arbitrary `suchThat` \(b1, b2, i) -> b1 <= Finite i &&  Finite (i + 1) <= b2) $
+      \(b1, b2, i) ->
+        IntegerInterval.relate (b1 <=..<= Finite i) (Finite (i + 1) <=..<= b2) == JustBefore
+
+prop_relate_two_intervals_overlap =
+  forAll (nonEmptyIntegerIntervalPairs (\lb1 ub1 lb2 ub2 -> lb1 < lb2 && lb2 < ub1 && ub1 < ub2)) $ \(a, b) ->
+    IntegerInterval.relate a b == Overlaps
+
+prop_relate_interval_starts_another =
+  forAll (nonEmptyIntegerIntervalPairs (\lb1 ub1 lb2 ub2 -> lb1 == lb2 && ub1 < ub2)) $ \(a, b) ->
+    IntegerInterval.relate a b == Starts
+
+prop_relate_interval_finishes_another =
+  forAll (nonEmptyIntegerIntervalPairs (\lb1 ub1 lb2 ub2 -> lb1 > lb2 && ub1 == ub2)) $ \(a, b) ->
+    IntegerInterval.relate a b == Finishes
+
+prop_relate_interval_contains_another =
+  forAll (nonEmptyIntegerIntervalPairs (\lb1 ub1 lb2 ub2 -> lb1 < lb2 && ub1 > ub2)) $ \(a, b) ->
+    IntegerInterval.relate a b == Contains
+
+{--------------------------------------------------------------------
   Comparison
 --------------------------------------------------------------------}
 
@@ -629,35 +699,35 @@
     ival1 :: IntegerInterval
     ival1 = 1 <=..<= 2
     ival2 = 1 <..< 2
-    ival3 = IntegerInterval.empty -- *
+    ival3 = IntegerInterval.empty
 
 case_mult_test3 = ival1 * ival2 @?= ival3
   where
     ival1 :: IntegerInterval
     ival1 = 1 <..< 2
     ival2 = 1 <..< 2
-    ival3 = IntegerInterval.empty -- *
+    ival3 = IntegerInterval.empty
 
 case_mult_test4 = ival1 * ival2 @?= ival3
   where
     ival1 :: IntegerInterval
     ival1 = 2 <..< PosInf
     ival2 = 3 <..< PosInf
-    ival3 = 11 <..< PosInf -- *
+    ival3 = 11 <..< PosInf
 
 case_mult_test5 = ival1 * ival2 @?= ival3
   where
     ival1 :: IntegerInterval
     ival1 = NegInf <..< (-3)
     ival2 = NegInf <..< (-2)
-    ival3 = 11 <..< PosInf -- *
+    ival3 = 11 <..< PosInf
 
 case_mult_test6 = ival1 * ival2 @?= ival3
   where
     ival1 :: IntegerInterval
     ival1 = 2 <..< PosInf
     ival2 = NegInf <..< (-2)
-    ival3 = NegInf <..< (-8) -- *
+    ival3 = NegInf <..< (-8)
 
 prop_abs_signum =
   forAll integerIntervals $ \a ->
@@ -671,6 +741,8 @@
   Lattice
 --------------------------------------------------------------------}
 
+#ifdef MIN_VERSION_lattices
+
 prop_Lattice_Leq_welldefined =
   forAll integerIntervals $ \a b ->
     a `L.meetLeq` b == a `L.joinLeq` b
@@ -683,6 +755,14 @@
   forAll integerIntervals $ \a ->
     L.bottom `L.joinLeq` a
 
+#else
+
+prop_Lattice_Leq_welldefined = True
+prop_top                     = True
+prop_bottom                  = True
+
+#endif
+
 {--------------------------------------------------------------------
   Read
 --------------------------------------------------------------------}
@@ -692,7 +772,7 @@
     i == read (show i)
 
 case_read_old =
-  read "interval (Finite 0, True) (PosInf, False)" @?= IntegerInterval.interval (Finite 0, True) (PosInf, False)
+  read "interval (Finite 0, Closed) (PosInf, Open)" @?= IntegerInterval.interval (Finite 0, Interval.Closed) (PosInf, Interval.Open)
 
 {--------------------------------------------------------------------
   NFData
@@ -764,6 +844,9 @@
   Generators
 --------------------------------------------------------------------}
 
+instance Arbitrary Interval.Boundary where
+  arbitrary = arbitraryBoundedEnum
+
 instance Arbitrary r => Arbitrary (Extended r) where
   arbitrary =
     oneof
@@ -786,6 +869,24 @@
 
 integerIntervals :: Gen IntegerInterval
 integerIntervals = arbitrary
+
+nonEmptyIntegerIntervalPairs
+  :: ( Extended Integer
+    -> Extended Integer
+    -> Extended Integer
+    -> Extended Integer
+    -> Bool)
+  -> Gen (IntegerInterval, IntegerInterval)
+nonEmptyIntegerIntervalPairs boundariesComparer = ap (fmap (,) integerIntervals) integerIntervals `suchThat`
+  (\(i1, i2) ->
+    (not . IntegerInterval.null $ i1) &&
+    (not . IntegerInterval.null $ i2) &&
+    boundariesComparer
+      (IntegerInterval.lowerBound i1)
+      (IntegerInterval.upperBound i1)
+      (IntegerInterval.lowerBound i2)
+      (IntegerInterval.upperBound i2)
+  )
 
 intervals :: Gen (Interval.Interval Rational)
 intervals = arbitrary
diff --git a/test/TestInterval.hs b/test/TestInterval.hs
--- a/test/TestInterval.hs
+++ b/test/TestInterval.hs
@@ -1,11 +1,15 @@
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, TemplateHaskell, RankNTypes, ScopedTypeVariables #-}
 module TestInterval (intervalTestGroup) where
 
+#ifdef MIN_VERSION_lattices
 import qualified Algebra.Lattice as L
+#endif
 import Control.DeepSeq
+import Control.Exception
 import Control.Monad
 import Data.Generics.Schemes
 import Data.Hashable
+import Data.Int
 import Data.Maybe
 import Data.Ratio
 import Data.Typeable
@@ -13,7 +17,11 @@
 import Test.Tasty
 import Test.Tasty.QuickCheck
 import Test.Tasty.HUnit
+import Test.Tasty.Options
 import Test.Tasty.TH
+#ifdef MIN_VERSION_quickcheck_classes_base
+import Test.QuickCheck.Classes.Base
+#endif
 
 import Data.Interval
   ( Interval, Extended (..), (<=..<=), (<=..<), (<..<=), (<..<)
@@ -22,7 +30,10 @@
   , (<??), (<=??), (==??), (>=??), (>??), (/=??)
   )
 import qualified Data.Interval as Interval
+import Data.IntervalRelation
 
+import TestInstances
+
 {--------------------------------------------------------------------
   empty
 --------------------------------------------------------------------}
@@ -198,7 +209,11 @@
   forAll intervals $ \a ->
     Interval.isSubsetOf a a
 
-prop_isSubsetOf_trans =
+test_isSubsetOf_trans :: [TestTree]
+test_isSubsetOf_trans =
+  (: []) $
+  adjustOption (\(QuickCheckMaxRatio r) -> QuickCheckMaxRatio (r * 10)) $
+  testProperty "isSubsetOf trans" $
   forAll intervals $ \a ->
   forAll intervals $ \b ->
   forAll intervals $ \c ->
@@ -307,6 +322,9 @@
 case_width_null =
   Interval.width Interval.empty @?= 0
 
+case_width_positive =
+  Interval.width (0 <=..< 10) @?= 10
+
 prop_width_singleton =
   forAll arbitrary $ \(r::Rational) ->
     Interval.width (Interval.singleton r) == 0
@@ -319,6 +337,81 @@
   Interval.mapMonotonic (+1) (0 <=..< 10) @?= ((1 <=..<11) :: Interval Rational)
 
 {--------------------------------------------------------------------
+  relate
+--------------------------------------------------------------------}
+
+prop_relate_equals =
+  forAll intervals $ \a ->
+    Interval.relate a a == Equal
+
+prop_relate_empty_contained_in_non_empty =
+  forAll (intervals `suchThat` (not . Interval.null)) $ \a ->
+    Interval.relate a Interval.empty == Contains
+
+prop_relate_detects_before =
+  forAll (nonEmptyIntervalPairs (\_ (ub1, _) (lb2, _) _ -> ub1 < lb2)) $ \(a, b) ->
+    Interval.relate a b == Before
+
+prop_relate_open_intervals_with_common_boundary_are_before =
+  forAll (arbitrary `suchThat` \(b1, b2, i) -> fst b1 < i && i < fst b2) $
+      \(b1 :: (Extended Rational, Interval.Boundary), b2, i :: Extended Rational) ->
+        Interval.relate (Interval.interval b1 (i, Interval.Open)) (Interval.interval (i, Interval.Open) b2) == Before
+
+prop_relate_right_closed_interval_just_before =
+  forAll (arbitrary `suchThat` \(b1, b2, i) -> fst b1 < i && i < fst b2) $
+      \(b1 :: (Extended Rational, Interval.Boundary), b2, i :: Extended Rational) ->
+        Interval.relate (Interval.interval b1 (i, Interval.Closed)) (Interval.interval (i, Interval.Open) b2) == JustBefore
+
+prop_relate_right_open_interval_just_before =
+  forAll (arbitrary `suchThat` \(b1, b2, i) -> fst b1 < i && i < fst b2) $
+      \(b1 :: (Extended Rational, Interval.Boundary), b2, i :: Extended Rational) ->
+        Interval.relate (Interval.interval b1 (i, Interval.Open)) (Interval.interval (i, Interval.Closed) b2) == JustBefore
+
+prop_relate_two_intervals_overlap =
+  forAll (nonEmptyIntervalPairs (\(lb1, _) (ub1, _) (lb2, _) (ub2, _) -> lb1 < lb2 && lb2 < ub1 && ub1 < ub2)) $ \(a, b) ->
+    Interval.relate a b == Overlaps
+
+prop_relate_interval_starts_another =
+  forAll (nonEmptyIntervalPairs (\lb1 (ub1, _) lb2 (ub2, _) -> lb1 == lb2 && ub1 < ub2)) $ \(a, b) ->
+    Interval.relate a b == Starts
+
+prop_relate_interval_finishes_another =
+  forAll (nonEmptyIntervalPairs (\(lb1, _) ub1 (lb2, _) ub2 -> lb1 > lb2 && ub1 == ub2)) $ \(a, b) ->
+    Interval.relate a b == Finishes
+
+prop_relate_interval_contains_another =
+  forAll (nonEmptyIntervalPairs (\(lb1, _) (ub1, _) (lb2, _) (ub2, _) -> lb1 < lb2 && ub1 > ub2)) $ \(a, b) ->
+    Interval.relate a b == Contains
+
+prop_relate_closed_interval_contains_open_interval_with_same_boundary =
+  forAll (arbitrary `suchThat` \(lb, rb) -> lb < rb) $
+    \(lb :: Rational, rb) ->
+      Interval.relate
+        (Interval.interval (Finite lb, Interval.Closed) (Finite rb, Interval.Closed))
+        (Interval.interval (Finite lb, Interval.Open) (Finite rb, Interval.Open))
+      == Contains
+
+prop_relate_one_singleton_before_another =
+  forAll (arbitrary `suchThat` uncurry (<)) $ \(r1 :: Rational, r2) ->
+    Interval.relate (Interval.singleton r1) (Interval.singleton r2) == Before
+
+prop_relate_singleton_starts_interval =
+  forAll (arbitrary `suchThat` uncurry (<)) $ \(r1 :: Rational, r2) b ->
+    Interval.relate (Interval.singleton r1) (Interval.interval (Finite r1, Interval.Closed) (Finite r2, b)) == Starts
+
+prop_relate_singleton_just_before_interval =
+  forAll (arbitrary `suchThat` uncurry (<)) $ \(r1 :: Rational, r2) b ->
+    Interval.relate (Interval.singleton r1) (Interval.interval (Finite r1, Interval.Open) (Finite r2, b)) == JustBefore
+
+prop_relate_singleton_finishes_interval =
+  forAll (arbitrary `suchThat` uncurry (<)) $ \(r1 :: Rational, r2) b ->
+    Interval.relate (Interval.singleton r2) (Interval.interval (Finite r1, b) (Finite r2, Interval.Closed)) == Finishes
+
+prop_relate_singleton_just_after_interval =
+  forAll (arbitrary `suchThat` uncurry (<)) $ \(r1 :: Rational, r2) b ->
+    Interval.relate (Interval.singleton r2) (Interval.interval (Finite r1, b) (Finite r2, Interval.Open)) == JustAfter
+
+{--------------------------------------------------------------------
   Comparison
 --------------------------------------------------------------------}
 
@@ -749,14 +842,332 @@
     i1 = -10 <=..< 0
     i2 = NegInf <..<= (-1/10)
 
-prop_recip_zero =
+case_recip_test4 = recip i1 @?= i2
+  where
+    i1, i2 :: Interval Rational
+    i1 = 0 <=..<= 10
+    i2 = (1/10) <=..< PosInf
+
+case_recip_test5 = recip i1 @?= i2
+  where
+    i1, i2 :: Interval Rational
+    i1 = -10 <=..<= 0
+    i2 = NegInf <..<= (-1/10)
+
+case_recip_test6 = recip i1 @?= i2
+  where
+    i1, i2 :: Interval Rational
+    i1 = 0 <=..<= 0
+    i2 = Interval.empty
+
+prop_recip =
   forAll intervals $ \a ->
-    0 `Interval.member` a ==> recip a == Interval.whole
+    if 0 `isInteriorPoint` a
+    then recip a === Interval.whole
+    else recip (recip a) === without0 a
 
+isInteriorPoint :: (Ord a, Show a) => a -> Interval a -> Bool
+isInteriorPoint x xs
+  = x `Interval.member` xs
+  && Finite x /= Interval.lowerBound xs
+  && Finite x /= Interval.upperBound xs
+
+without0 :: (Ord a, Num a) => Interval a -> Interval a
+without0 xs = case Interval.lowerBound' xs of
+  (0, Interval.Closed) ->
+    Interval.interval (0, Interval.Open) (Interval.upperBound' xs)
+  _ -> case Interval.upperBound' xs of
+    (0, Interval.Closed) ->
+      Interval.interval (Interval.lowerBound' xs) (0, Interval.Open)
+    _ -> xs
+
 {--------------------------------------------------------------------
+  Floating
+--------------------------------------------------------------------}
+
+prop_exp_singleton = floatingSingleton exp
+
+prop_exp_mid_point = floatingMidPoint exp
+
+case_exp_whole = exp Interval.whole @?= 0 <..< PosInf
+
+case_exp_empty = exp Interval.empty @?= Interval.empty
+
+prop_log_singleton a = a > 0 ==>
+  floatingSingleton log a
+
+prop_log_mid_point = floatingMidPoint log . Interval.intersection (0 <..< PosInf)
+
+case_log_whole = log Interval.whole   @?= Interval.whole
+case_log_half1 = log (0 <=..< PosInf) @?= Interval.whole
+case_log_half2 = log (0 <..< PosInf)  @?= Interval.whole
+case_log_zero  = log (0 :: Interval Double) @?= Interval.empty
+
+case_log_empty = log Interval.empty @?= Interval.empty
+
+prop_log_exp a = log (exp a) =~= a
+
+prop_exp_log a = exp (log a) =~= a `Interval.intersection` (0 <..< PosInf)
+
+-------------------------------------------------------------------------------
+
+prop_sqrt_singleton = floatingSingleton sqrt
+
+prop_sqrt_mid_point = floatingMidPoint sqrt . Interval.intersection (0 <=..< PosInf)
+
+case_sqrt_whole = sqrt Interval.whole @?= 0 <=..< PosInf
+
+case_sqrt_empty = sqrt Interval.empty @?= Interval.empty
+
+prop_sqr_sqrt a = sqrt a * sqrt a =~= a `Interval.intersection` (0 <=..< PosInf)
+
+prop_sqrt_sqr a = sqrt (a * a) =~= abs a
+
+-------------------------------------------------------------------------------
+
+prop_pow_singleton_Double_Double a' b' =
+  not (isInfinite c || isNaN c) ==>
+    Interval.singleton a ** Interval.singleton b =~= Interval.singleton c
+  where
+    a = min 5 $ max (-5) a'
+    b = min 5 $ max (-5) b'
+    c = a ** b
+
+prop_pow_singleton_Double_Integer 0 b'
+  | b' < 0 = discard
+prop_pow_singleton_Double_Integer a' b' =
+  Interval.singleton a ** Interval.singleton b =~= Interval.singleton (a ** b)
+  where
+    a = min 5 $ max (-5) a'
+    b = min 5 $ max (-5) $ fromInteger b'
+
+prop_pow_singleton_Integer_Double a' b =
+  not (isInfinite c || isNaN c) ==>
+    Interval.singleton a ** Interval.singleton b =~= Interval.singleton (a ** b)
+  where
+    a = fromInteger a'
+    c = a ** b
+
+prop_pow_mid_point a' b' = case (Interval.pickup a, Interval.pickup b) of
+  (Nothing, _) -> discard
+  (_, Nothing) -> discard
+  (Just x, Just y) -> let z = x ** y :: Double in not (isInfinite z || isNaN z) ==>
+    ioProperty $ do
+      x <- try (evaluate (a ** b))
+      return $ case x of
+        Left LossOfPrecision -> discard
+        Right c -> distance z c < Finite (1e-10 * (1 `max` abs z))
+  where
+    -- for larger intervals the loss of precision becomes exponentially huge
+    a = Interval.mapMonotonic (min 5 . max (-5)) a'
+    b = Interval.mapMonotonic (min 5 . max (-5)) b'
+
+prop_pow_empty_1 :: Interval Double -> Bool
+prop_pow_empty_1 x = Interval.null (Interval.empty ** x)
+
+prop_pow_empty_2 :: Interval Double -> Bool
+prop_pow_empty_2 x = Interval.null (x ** Interval.empty)
+
+-------------------------------------------------------------------------------
+
+prop_sin_singleton a =
+  distance (sin a :: Double) (sin (Interval.singleton a)) <= 1e-10
+
+prop_sin_mid_point a
+  | Interval.isSingleton a = discard
+  | otherwise = floatingMidPoint sin a
+
+case_sin_whole = sin Interval.whole @?= -1 <=..<= 1
+
+case_sin_empty = sin Interval.empty @?= Interval.empty
+
+prop_asin_singleton a = floatingSingleton asin (if abs a < 1 then a else recip a)
+
+prop_asin_mid_point = floatingMidPoint asin . Interval.intersection (-1 <=..<= 1)
+
+case_asin_whole = asin Interval.whole @?= Finite (-pi / 2) <=..<= Finite (pi / 2)
+
+case_asin_empty = asin Interval.empty @?= Interval.empty
+
+prop_sin_asin a = sin (asin a) =~= a `Interval.intersection` (-1 <=..<= 1)
+
+-------------------------------------------------------------------------------
+
+prop_cos_singleton a =
+  distance (cos a :: Double) (cos (Interval.singleton a)) <= 1e-10
+
+prop_cos_mid_point a
+  | Interval.isSingleton a = discard
+  | otherwise = floatingMidPoint cos a
+
+case_cos_whole = cos Interval.whole @?= -1 <=..<= 1
+
+case_cos_empty = cos Interval.empty @?= Interval.empty
+
+prop_acos_singleton a = floatingSingleton acos (if abs a < 1 then a else recip a)
+
+prop_acos_mid_point = floatingMidPoint acos . Interval.intersection (-1 <=..<= 1)
+
+case_acos_whole = acos Interval.whole @?= 0 <=..<= Finite pi
+
+case_acos_empty = acos Interval.empty @?= Interval.empty
+
+prop_cos_acos a = cos (acos a) =~= a `Interval.intersection` (-1 <=..<= 1)
+
+-------------------------------------------------------------------------------
+
+prop_tan_singleton a =
+  distance (tan a :: Double) (tan (Interval.singleton a)) <= 1e-10
+
+prop_tan_mid_point a = case Interval.pickup a of
+  Nothing -> discard
+  Just x -> let z = tan x :: Double in not (isInfinite z || isNaN z) ==>
+    ioProperty $ do
+      x <- try (evaluate (tan a))
+      return $ case x of
+        Left LossOfPrecision -> discard
+        Right c -> distance z c < Finite (1e-10 * (1 `max` abs z))
+
+case_tan_whole = tan Interval.whole @?= Interval.whole
+
+case_tan_empty = tan Interval.empty @?= Interval.empty
+
+prop_atan_singleton = floatingSingleton atan
+
+prop_atan_mid_point = floatingMidPoint atan
+
+case_atan_whole = atan Interval.whole @?= Finite (-pi / 2) <=..<= Finite (pi / 2)
+
+case_atan_empty = atan Interval.empty @?= Interval.empty
+
+prop_tan_atan a = case (Interval.lowerBound a, Interval.upperBound a) of
+  (Finite{}, Finite{}) -> tan (atan a) =~= a
+  _ -> discard
+
+-------------------------------------------------------------------------------
+
+prop_sinh_singleton = floatingSingleton sinh
+
+prop_sinh_mid_point = floatingMidPoint sinh
+
+case_sinh_whole = sinh Interval.whole @?= Interval.whole
+
+case_sinh_empty = sinh Interval.empty @?= Interval.empty
+
+prop_asinh_singleton = floatingSingleton asinh
+
+prop_asinh_mid_point = floatingMidPoint asinh
+
+case_asinh_whole = asinh Interval.whole @?= Interval.whole
+
+case_asinh_empty = asinh Interval.empty @?= Interval.empty
+
+prop_asinh_sinh a' = asinh (sinh a) =~= a
+  where
+    -- for larger intervals the loss of precision becomes exponentially huge
+    a = Interval.mapMonotonic (min 5 . max (-5)) a'
+
+prop_sinh_asinh a = sinh (asinh a) =~= a
+
+-------------------------------------------------------------------------------
+
+prop_cosh_singleton = floatingSingleton cosh
+
+prop_cosh_mid_point = floatingMidPoint cosh
+
+case_cosh_whole = cosh Interval.whole @?= 1 <=..< PosInf
+
+case_cosh_empty = cosh Interval.empty @?= Interval.empty
+
+prop_acosh_singleton = floatingSingleton acosh
+
+prop_acosh_mid_point = floatingMidPoint acosh . Interval.intersection (1 <=..< PosInf)
+
+case_acosh_whole = acosh Interval.whole @?= 0 <=..< PosInf
+
+case_acosh_empty = acosh Interval.empty @?= Interval.empty
+
+prop_acosh_cosh a' = acosh (cosh a) =~= abs a
+  where
+    -- for larger intervals the loss of precision becomes exponentially huge
+    a = Interval.mapMonotonic (min 5 . max (-5)) a'
+
+prop_cosh_acosh a = cosh (acosh a) =~= a `Interval.intersection` (1 <=..< PosInf)
+
+-------------------------------------------------------------------------------
+
+prop_tanh_singleton a = abs a <= 10 ==>
+  floatingSingleton tanh a
+
+prop_tanh_mid_point = floatingMidPoint tanh . Interval.intersection (-5 <=..<= 5)
+
+case_tanh_whole = tanh Interval.whole @?= -1 <..< 1
+
+case_tanh_empty = tanh Interval.empty @?= Interval.empty
+
+prop_atanh_singleton 1    = atanh 1 === Interval.empty
+prop_atanh_singleton (-1) = atanh (-1) === Interval.empty
+prop_atanh_singleton a    = floatingSingleton atanh (if abs a < 1 then a else recip a)
+
+prop_atanh_mid_point = floatingMidPoint atanh . Interval.intersection (-1 <..< 1)
+
+case_atanh_whole = atanh Interval.whole @?= Interval.whole
+
+case_atanh_empty = atanh Interval.empty @?= Interval.empty
+
+prop_atanh_tanh a' = atanh (tanh a) =~= a
+  where
+    -- for larger intervals the loss of precision becomes exponentially huge
+    a = Interval.mapMonotonic (min 5 . max (-5)) a'
+
+prop_tanh_atanh = uncurry (=~=) . tanhAtanh
+
+case_tanh_atanh_1 = uncurry (@?=) $ tanhAtanh (-1 <=..<= 1)
+case_tanh_atanh_2 = uncurry (@?=) $ tanhAtanh (-1 <=..< 1)
+case_tanh_atanh_3 = uncurry (@?=) $ tanhAtanh (-1 <..<= 1)
+case_tanh_atanh_4 = uncurry (@?=) $ tanhAtanh (-1 <..< 1)
+
+tanhAtanh :: Interval Double -> (Interval Double, Interval Double)
+tanhAtanh a = (tanh (atanh a), a `Interval.intersection` (-1 <..< 1))
+
+-------------------------------------------------------------------------------
+
+floatingSingleton :: (forall a. Floating a => a -> a) -> Double -> Property
+floatingSingleton f a = Interval.singleton (f a) === f (Interval.singleton a)
+
+distance :: (Ord r, Num r) => r -> Interval r -> Extended r
+distance x xs
+  | Interval.member x xs = 0
+  | otherwise
+  = abs (Finite x - Interval.lowerBound xs) `min`
+    abs (Finite x - Interval.upperBound xs)
+
+floatingMidPoint :: (forall a. Floating a => a -> a) -> Interval Double -> Property
+floatingMidPoint f a = case Interval.pickup a of
+  Nothing -> discard
+  Just x  -> property $ f x `Interval.member` f a
+
+infix 4 =~=
+(=~=) :: Interval Double -> Interval Double -> Property
+a =~= b
+  | eqPair (Interval.lowerBound' a) (Interval.lowerBound' b)
+  , eqPair (Interval.upperBound' a) (Interval.upperBound' b)
+  = property True
+  | otherwise
+  = a === b
+  where
+    eqPair (x, a) (y, b) = eqExt x y && a == b
+
+    eqExt (Finite x) (Finite y) =
+      abs (x - y) < 1e-10 * (1 `max` abs x `max` abs y)
+    eqExt x y = x == y
+
+{--------------------------------------------------------------------
   Lattice
 --------------------------------------------------------------------}
 
+#ifdef MIN_VERSION_lattices
+
 prop_Lattice_Leq_welldefined =
   forAll intervals $ \a b ->
     a `L.meetLeq` b == a `L.joinLeq` b
@@ -769,6 +1180,14 @@
   forAll intervals $ \a ->
     L.bottom `L.joinLeq` a
 
+#else
+
+prop_Lattice_Leq_welldefined = True
+prop_top                     = True
+prop_bottom                  = True
+
+#endif
+
 {--------------------------------------------------------------------
   Read
 --------------------------------------------------------------------}
@@ -778,8 +1197,8 @@
     i == read (show i)
 
 case_read_old =
-  read "interval (Finite (0 % 1), True) (PosInf, False)" @?= 
-  (Interval.interval (Finite 0, True) (PosInf, False) :: Interval Rational)
+  read "interval (Finite (0 % 1), Closed) (PosInf, Open)" @?=
+  (Interval.interval (Finite 0, Interval.Closed) (PosInf, Interval.Open) :: Interval Rational)
 
 {--------------------------------------------------------------------
   NFData
@@ -810,25 +1229,44 @@
       | otherwise = x
 
 {--------------------------------------------------------------------
-  Generators
+  Storable
 --------------------------------------------------------------------}
 
-instance Arbitrary r => Arbitrary (Extended r) where
-  arbitrary =
-    oneof
-    [ return NegInf
-    , return PosInf
-    , liftM Finite arbitrary
-    ]
+#ifdef MIN_VERSION_quickcheck_classes_base
+test_Storable_Int8 = map (uncurry testProperty) $ lawsProperties $
+  storableLaws (Proxy :: Proxy (Interval Int8))
+test_Storable_Int = map (uncurry testProperty) $ lawsProperties $
+  storableLaws (Proxy :: Proxy (Interval Int))
+#else
+test_Storable_Int8 = []
+test_Storable_Int = []
+#endif
 
-instance (Arbitrary r, Ord r) => Arbitrary (Interval r) where
-  arbitrary = do
-    lb <- arbitrary
-    ub <- arbitrary
-    return $ Interval.interval lb ub
+{--------------------------------------------------------------------
+  Generators
+--------------------------------------------------------------------}
 
-intervals :: Gen (Interval Rational)
-intervals = arbitrary
+nonEmptyIntervalPairs
+  :: ( (Extended Rational, Interval.Boundary)
+    -> (Extended Rational, Interval.Boundary)
+    -> (Extended Rational, Interval.Boundary)
+    -> (Extended Rational, Interval.Boundary)
+    -> Bool)
+  -> Gen (Interval Rational, Interval Rational)
+nonEmptyIntervalPairs boundariesComparer = ap (fmap (,) intervals) intervals `suchThat`
+  (\(i1, i2) ->
+    (not . Interval.null $ i1) &&
+    (not . Interval.null $ i2) &&
+    boundariesComparer
+      (Interval.lowerBound' i1)
+      (Interval.upperBound' i1)
+      (Interval.lowerBound' i2)
+      (Interval.upperBound' i2)
+  )
+
+{--------------------------------------------------------------------
+  Test intervals
+--------------------------------------------------------------------}
 
 pos :: Interval Rational
 pos = 0 <..< PosInf
diff --git a/test/TestIntervalMap.hs b/test/TestIntervalMap.hs
--- a/test/TestIntervalMap.hs
+++ b/test/TestIntervalMap.hs
@@ -1,8 +1,7 @@
 {-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, TemplateHaskell, ScopedTypeVariables #-}
 module TestIntervalMap (intervalMapTestGroup) where
 
-import Control.Applicative ((<$>))
 import Control.DeepSeq
 import Control.Exception (evaluate)
 import Control.Monad
@@ -11,12 +10,14 @@
 import Data.Generics.Schemes
 import Data.Hashable
 import Data.Maybe
-import Data.Monoid
-import Data.Traversable
+#if __GLASGOW_HASKELL__ < 804
+import Data.Semigroup ((<>))
+#endif
 import Data.Typeable
 
 import Test.ChasingBottoms.IsBottom
 import Test.QuickCheck.Function
+import Test.Tasty
 import Test.Tasty.QuickCheck
 import Test.Tasty.HUnit
 import Test.Tasty.TH
@@ -32,14 +33,17 @@
   empty
 --------------------------------------------------------------------}
 
+prop_empty_is_bottom :: Property
 prop_empty_is_bottom =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.isSubmapOf IML.empty a
 
+prop_null_empty :: Property
 prop_null_empty =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.null a == (a == IML.empty)
 
+case_null_empty :: Assertion
 case_null_empty =
   IML.null (IML.empty :: IntervalMap Rational Integer) @?= True
 
@@ -47,17 +51,21 @@
   whole
 --------------------------------------------------------------------}
 
+case_nonnull_whole :: Assertion
 case_nonnull_whole =
   IML.null (IML.whole 0 :: IntervalMap Rational Integer) @?= False
 
+prop_whole_Lazy_Strict :: Property
 prop_whole_Lazy_Strict = do
   forAll arbitrary $ \(a :: Integer) ->
     (IML.whole a :: IntervalMap Rational Integer) == IMS.whole a
 
+case_whole_nonstrict :: Assertion
 case_whole_nonstrict = do
   _ <- evaluate (IML.whole bottom :: IntervalMap Rational Integer)
   return ()
 
+case_whole_strict :: Assertion
 case_whole_strict =
   isBottom (IMS.whole bottom :: IntervalMap Rational Integer) @?= True
 
@@ -65,20 +73,24 @@
   singleton
 --------------------------------------------------------------------}
 
+prop_singleton_insert :: Property
 prop_singleton_insert = do
   forAll arbitrary $ \(i :: Interval Rational) ->
     forAll arbitrary $ \(a :: Integer) ->
       IML.singleton i a == IML.insert i a IML.empty
 
+prop_singleton_Lazy_Strict :: Property
 prop_singleton_Lazy_Strict = do
   forAll arbitrary $ \(i :: Interval Rational) ->
     forAll arbitrary $ \(a :: Integer) ->
       IML.singleton i a == IMS.singleton i a
 
+case_singleton_nonstrict :: Assertion
 case_singleton_nonstrict = do
   _ <- evaluate (IML.singleton 0 bottom :: IntervalMap Rational Integer)
   return ()
 
+case_singleton_strict :: Assertion
 case_singleton_strict =
   isBottom (IMS.singleton 0 bottom :: IntervalMap Rational Integer) @?= True
 
@@ -86,16 +98,19 @@
   insert
 --------------------------------------------------------------------}
 
+prop_insert_whole :: Property
 prop_insert_whole =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \a ->
       IML.insert Interval.whole a m == IML.whole a
 
+prop_insert_empty :: Property
 prop_insert_empty =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \a ->
       IML.insert Interval.empty a m == m
 
+prop_insert_comm :: Property
 prop_insert_comm =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \(i1,a1) ->
@@ -104,12 +119,14 @@
     ==>
     (IML.insert i1 a1 (IML.insert i2 a2 m) == IML.insert i2 a2 (IML.insert i1 a1 m))
 
+prop_insert_isSubmapOf :: Property
 prop_insert_isSubmapOf =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
       forAll arbitrary $ \a ->
         IML.isSubmapOf (IML.singleton i a) (IML.insert i a m)
 
+prop_insert_member :: Property
 prop_insert_member =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
@@ -118,6 +135,7 @@
           Just k -> IML.member k (IML.insert i a m)
           Nothing -> True
 
+prop_insert_lookup :: Property
 prop_insert_lookup =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
@@ -126,6 +144,7 @@
           Just k -> IML.lookup k (IML.insert i a m) == Just a
           Nothing -> True
 
+prop_insert_bang :: Property
 prop_insert_bang =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
@@ -134,22 +153,26 @@
           Just k -> IML.insert i a m IML.! k == a
           Nothing -> True
 
+prop_insert_Lazy_Strict :: Property
 prop_insert_Lazy_Strict =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
       forAll arbitrary $ \a ->
         IML.insert i a m == IMS.insert i a m
 
+prop_insert_nonstrict :: Property
 prop_insert_nonstrict =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
       IML.insert i bottom m `seq` True
 
+prop_insert_strict :: Property
 prop_insert_strict =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
       isBottom $ IMS.insert i bottom m
 
+prop_insertWith_Lazy_Strict :: Property
 prop_insertWith_Lazy_Strict =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \(f :: Fun (Integer,Integer) Integer) ->
@@ -157,11 +180,13 @@
         forAll arbitrary $ \a ->
           IML.insertWith (curry (apply f)) i a m == IMS.insertWith (curry (apply f)) i a m
 
+case_insertWith_nonstrict :: Assertion
 case_insertWith_nonstrict = evaluate (IML.insertWith (\_ _ -> bottom) (3 <=..< 7) 1 m) >> return ()
   where
     m :: IntervalMap Rational Integer
     m = IML.singleton (0 <=..< 10) 0
 
+case_insertWith_strict :: Assertion
 case_insertWith_strict = isBottom (IMS.insertWith (\_ _ -> bottom) (3 <=..< 7) 1 m) @?= True
   where
     m :: IntervalMap Rational Integer
@@ -171,24 +196,29 @@
   delete / update
 --------------------------------------------------------------------}
 
+prop_delete_empty :: Property
 prop_delete_empty =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
      IML.delete Interval.empty m == m
 
+prop_delete_whole :: Property
 prop_delete_whole =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
      IML.delete Interval.whole m == IML.empty
 
+prop_delete_from_empty :: Property
 prop_delete_from_empty =
   forAll arbitrary $ \(i :: Interval Rational) ->
      IML.delete i (IML.empty :: IntervalMap Rational Integer) == IML.empty
 
+prop_delete_comm :: Property
 prop_delete_comm =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \i1 ->
   forAll arbitrary $ \i2 ->
      IML.delete i1 (IML.delete i2 m) == IML.delete i2 (IML.delete i1 m)
 
+prop_delete_notMember :: Property
 prop_delete_notMember =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
@@ -196,6 +226,7 @@
         Just k -> IML.notMember k (IML.delete i m)
         Nothing -> True
 
+prop_delete_lookup :: Property
 prop_delete_lookup =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
@@ -203,6 +234,7 @@
         Just k -> IML.lookup k (IML.delete i m) == Nothing
         Nothing -> True
 
+case_adjust :: Assertion
 case_adjust = IML.adjust (+1) (3 <=..< 7) m @?= expected
   where
     m :: IntervalMap Rational Integer
@@ -225,12 +257,14 @@
       , (8 <=..< 10, 8)
       ]
 
+prop_adjust_Lazy_Strict :: Property
 prop_adjust_Lazy_Strict =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \(f :: Fun Integer Integer) ->
       forAll arbitrary $ \i ->
         IML.adjust (apply f) i m == IMS.adjust (apply f) i m
 
+case_asjust_nonstrict :: Assertion
 case_asjust_nonstrict = do
   _ <- evaluate $ IML.adjust (\_ -> bottom) (3 <=..< 7) m
   return ()
@@ -238,11 +272,13 @@
     m :: IntervalMap Rational Integer
     m = IML.singleton (0 <=..< 10) 0
 
+case_asjust_strict :: Assertion
 case_asjust_strict = isBottom (IMS.adjust (\_ -> bottom) (3 <=..< 7) m) @?= True
   where
     m :: IntervalMap Rational Integer
     m = IMS.singleton (0 <=..< 10) 0
 
+prop_alter :: Property
 prop_alter =
   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->
   forAll arbitrary $ \i ->
@@ -252,12 +288,14 @@
       Just k ->
         IML.lookup k (IML.alter (apply f) i m) == apply f (IML.lookup k m)
 
+prop_alter_Lazy_Strict :: Property
 prop_alter_Lazy_Strict =
   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->
   forAll arbitrary $ \i ->
   forAll arbitrary $ \f ->
     IML.alter (apply f) i m == IMS.alter (apply f) i m
 
+prop_alter_nonstrict :: Property
 prop_alter_nonstrict =
   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->
   forAll arbitrary $ \i ->
@@ -265,6 +303,7 @@
     ==>
     (IML.alter (\_ -> Just bottom) i m `seq` True)
 
+prop_alter_strict :: Property
 prop_alter_strict =
   forAll arbitrary $ \(m :: IntervalMap Rational Int) ->
   forAll arbitrary $ \i ->
@@ -276,60 +315,72 @@
   Union
 --------------------------------------------------------------------}
 
+prop_union_assoc :: Property
 prop_union_assoc =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \b ->
   forAll arbitrary $ \c ->
     IML.union a (IML.union b c) == IML.union (IML.union a b) c
 
+prop_union_unitL :: Property
 prop_union_unitL =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.union IML.empty a == a
 
+prop_union_unitR :: Property
 prop_union_unitR =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.union a IML.empty == a
 
+prop_union_isSubmapOf :: Property
 prop_union_isSubmapOf =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \b ->
     IML.isSubmapOf a (IML.union a b)
 
+prop_union_isSubmapOf_equiv :: Property
 prop_union_isSubmapOf_equiv =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \b ->
     IML.isSubmapOf (IML.union a b) b
     == IML.isSubmapOf a b
 
+case_unions_empty_list :: Assertion
 case_unions_empty_list =
   IML.unions [] @?= (IML.empty :: IntervalMap Rational Integer)
 
+prop_unions_singleton_list :: Property
 prop_unions_singleton_list =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.unions [a] == a
 
+prop_unions_two_elems :: Property
 prop_unions_two_elems =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \b ->
     IML.unions [a,b] == IML.union a b
 
+case_unionWith :: Assertion
 case_unionWith = actual @?= expected
   where
     actual, expected :: IntervalMap Rational Integer
     actual = IML.unionWith (+) (IML.singleton (0 <=..<= 10) 1) (IML.singleton (5 <=..<= 15) 2)
     expected = IML.fromList [(0 <=..< 5, 1), (5 <=..<= 10, 3), (10 <..<= 15, 2)]
 
+prop_unionWith_Lazy_Strict :: Property
 prop_unionWith_Lazy_Strict =
   forAll arbitrary $ \(a :: IntervalMap Rational Int) ->
   forAll arbitrary $ \b ->
   forAll arbitrary $ \f ->
     IML.unionWith (curry (apply f)) a b == IMS.unionWith (curry (apply f)) a b
 
+prop_unionWith_nonstrict :: Property
 prop_unionWith_nonstrict =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \b ->
     IML.unionWith (\_ _ -> bottom) a b `seq` True
 
+prop_unionWith_strict :: Property
 prop_unionWith_strict =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \b ->
@@ -341,28 +392,33 @@
   Intersection
 --------------------------------------------------------------------}
 
+prop_intersection_isSubmapOf :: Property
 prop_intersection_isSubmapOf =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \b ->
       IML.isSubmapOf (IML.intersection a b) a
 
+case_intersectionWith :: Assertion
 case_intersectionWith = actual @?= expected
   where
     actual, expected :: IntervalMap Rational Integer
     actual = IML.intersectionWith (+) (IML.singleton (0 <=..< 10) 1) (IML.singleton (5 <..<= 5) 1)
     expected = IML.singleton (5 <..< 5) 2
 
+prop_intersectionWith_Lazy_Strict :: Property
 prop_intersectionWith_Lazy_Strict =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \(f :: Fun (Integer,Integer) Integer) ->
     IML.intersectionWith (curry (apply f)) a b == IMS.intersectionWith (curry (apply f)) a b
 
+prop_intersectionWith_nonstrict :: Property
 prop_intersectionWith_nonstrict =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->
     IML.intersectionWith (\_ _ -> bottom :: Integer) a b `seq` True
 
+prop_intersectionWith_strict :: Property
 prop_intersectionWith_strict =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->
@@ -374,6 +430,7 @@
   Difference
 --------------------------------------------------------------------}
 
+prop_difference_isSubmapOf :: Property
 prop_difference_isSubmapOf =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \(b :: IntervalMap Rational Integer) ->
@@ -383,15 +440,18 @@
   member / lookup
 --------------------------------------------------------------------}
 
+prop_notMember_empty :: Property
 prop_notMember_empty =
   forAll arbitrary $ \(r::Rational) ->
     r `IML.notMember` (IML.empty :: IntervalMap Rational Integer)
 
+case_findWithDefault_case1 :: Assertion
 case_findWithDefault_case1 = IML.findWithDefault "B" 0 m @?= "A"
   where
     m :: IntervalMap Rational String
     m = IML.singleton (0 <=..<1) "A"
 
+case_findWithDefault_case2 :: Assertion
 case_findWithDefault_case2 = IML.findWithDefault "B" 1 m @?= "B"
   where
     m :: IntervalMap Rational String
@@ -401,10 +461,12 @@
   isSubsetOf
 --------------------------------------------------------------------}
 
+prop_isSubmapOf_reflexive :: Property
 prop_isSubmapOf_reflexive =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     a `IML.isSubmapOf` a
 
+prop_isProperSubsetOf_irreflexive :: Property
 prop_isProperSubsetOf_irreflexive =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     not (a `IML.isProperSubmapOf` a)
@@ -413,6 +475,7 @@
   span
 --------------------------------------------------------------------}
 
+prop_span :: Property
 prop_span =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.span a == IntervalSet.span (IML.keysSet a)
@@ -421,21 +484,25 @@
   map
 --------------------------------------------------------------------}
 
+case_mapKeysMonotonic :: Assertion
 case_mapKeysMonotonic = IML.mapKeysMonotonic (+1) m1 @?= m2
   where
     m1, m2 :: IntervalMap Rational String
     m1 = IML.fromList [(0 <=..< 1, "A"), (2 <..<= 3, "B")]
     m2 = IML.fromList [(1 <=..< 2, "A"), (3 <..<= 4, "B")]
 
+prop_map_Lazy_Strict :: Property
 prop_map_Lazy_Strict =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \(f :: Fun Integer Integer) ->
     IML.map (apply f) m == IMS.map (apply f) m
 
+prop_map_nonstrict :: Property
 prop_map_nonstrict =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.map (const (bottom :: Integer)) a `seq` True
 
+prop_map_strict :: Property
 prop_map_strict =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     not (IMS.null a)
@@ -473,50 +540,60 @@
   toList / fromList
 --------------------------------------------------------------------}
 
+prop_fromList_toList_id :: Property
 prop_fromList_toList_id =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.fromList (IML.toList a) == a
 
+prop_toAscList_toDescList :: Property
 prop_toAscList_toDescList =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     IML.toDescList a == reverse (IML.toAscList a)
 
+case_fromList :: Assertion
 case_fromList = actual @?= expected
   where
     actual, expected :: IntervalMap Rational Integer
     actual = IML.fromList [(0 <=..< 10, 1), (5 <..<= 15, 2)]
     expected = IML.fromList [(0 <=..<= 5, 1), (5 <..<= 15, 2)]
 
+case_fromListWith :: Assertion
 case_fromListWith = actual @?= expected
   where
     actual, expected :: IntervalMap Rational Integer
     actual = IML.fromListWith (+) [(0 <=..< 10, 1), (5 <..<= 15, 2)]
     expected = IML.fromList [(0 <=..<= 5, 1), (5 <..< 10, 3), (10 <=..<= 15, 2)]
 
+prop_fromList_Lazy_Strict :: Property
 prop_fromList_Lazy_Strict =
   forAll arbitrary $ \xs ->
     (IML.fromList xs :: IntervalMap Rational Integer) == IMS.fromList xs
 
+case_fromList_nonstrict :: Assertion
 case_fromList_nonstrict = evaluate m >> return ()
   where
     m :: IntervalMap Rational Integer
     m = IML.fromList [(0 <=..< 10, bottom), (5 <..<= 15, bottom)]
 
+case_fromList_strict :: Assertion
 case_fromList_strict = isBottom m @?= True
   where
     m :: IntervalMap Rational Integer
     m = IMS.fromList [(0 <=..< 10, bottom), (5 <..<= 15, bottom)]
 
+prop_fromListWith_Lazy_Strict :: Property
 prop_fromListWith_Lazy_Strict =
   forAll arbitrary $ \xs ->
     forAll arbitrary $ \f ->
       (IML.fromListWith (curry (apply f)) xs :: IntervalMap Rational Integer) == IMS.fromListWith (curry (apply f))  xs
 
+case_fromListWith_nonstrict :: Assertion
 case_fromListWith_nonstrict = evaluate m >> return ()
   where
     m :: IntervalMap Rational Integer
     m = IML.fromListWith (\_ _ -> bottom) [(0 <=..< 10, 1), (5 <..<= 15, 2)]
 
+case_fromListWith_strict :: Assertion
 case_fromListWith_strict = isBottom m @?= True
   where
     m :: IntervalMap Rational Integer
@@ -526,6 +603,7 @@
   Filter
 --------------------------------------------------------------------}
 
+case_filter :: Assertion
 case_filter = actual @?= expected
   where
     m, expected, actual :: IntervalMap Rational Integer
@@ -543,6 +621,7 @@
       ]
     actual = IML.filter even m
 
+prop_split :: Property
 prop_split =
   forAll arbitrary $ \(m :: IntervalMap Rational Integer) ->
     forAll arbitrary $ \i ->
@@ -556,6 +635,7 @@
            , and [i <! j | j <- IML.keys m3]
            ])
 
+case_split_case1 :: Assertion
 case_split_case1 =
   IML.split (5 <=..<= 9) m @?= (smaller, middle, larger)
   where
@@ -581,6 +661,7 @@
       , (20 <..<= 30, "C")
       ]
 
+case_split_case2 :: Assertion
 case_split_case2 =
   IML.split (5 <=..< 10) m @?= (smaller, middle, larger)
   where
@@ -606,6 +687,7 @@
       , (20 <..<= 30, "C")
       ]
 
+case_split_case3 :: Assertion
 case_split_case3 =
   IML.split (5 <=..<= 10) m @?= (smaller, middle, larger)
   where
@@ -630,6 +712,7 @@
       , (20 <..<= 30, "C")
       ]
 
+case_split_case4 :: Assertion
 case_split_case4 =
   IML.split (5 <=..< 10) m @?= (smaller, middle, larger)
   where
@@ -654,6 +737,7 @@
       , (20  <..<= 30, "C")
       ]
 
+case_split_case5 :: Assertion
 case_split_case5 =
   IML.split (5 <=..<= 10) m @?= (smaller, middle, larger)
   where
@@ -679,6 +763,7 @@
       , (20 <..<= 30, "C")
       ]
 
+case_split_case6 :: Assertion
 case_split_case6 =
   IML.split (5 <=..< 20) m @?= (smaller, middle, larger)
   where
@@ -704,6 +789,7 @@
       , (20 <..<= 30, "C")
       ]
 
+case_split_case7 :: Assertion
 case_split_case7 =
   IML.split (5 <=..<= 20) m @?= (smaller, middle, larger)
   where
@@ -728,6 +814,7 @@
       [ (20 <..<= 30, "C")
       ]
 
+case_split_case8 :: Assertion
 case_split_case8 =
   IML.split (5 <=..< 21) m @?= (smaller, middle, larger)
   where
@@ -757,6 +844,7 @@
   Eq
 --------------------------------------------------------------------}
 
+prop_Eq_reflexive :: Property
 prop_Eq_reflexive =
   forAll arbitrary $ \(i :: IntervalMap Rational Integer) ->
     i == i
@@ -765,6 +853,7 @@
   Show / Read
 --------------------------------------------------------------------}
 
+prop_show_read_invariance :: Property
 prop_show_read_invariance =
   forAll arbitrary $ \(i :: IntervalMap Rational Integer) ->
     i == read (show i)
@@ -773,24 +862,28 @@
   Monoid
 --------------------------------------------------------------------}
 
+prop_monoid_assoc :: Property
 prop_monoid_assoc =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
   forAll arbitrary $ \b ->
   forAll arbitrary $ \c ->
     a <> (b <> c) == (a <> b) <> c
 
+prop_monoid_unitL :: Property
 prop_monoid_unitL =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
-    mempty <> a == a
+    IML.empty <> a == a
 
+prop_monoid_unitR :: Property
 prop_monoid_unitR =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
-    a <> mempty == a
+    a <> IML.empty == a
 
 {--------------------------------------------------------------------
   NFData
 --------------------------------------------------------------------}
 
+prop_rnf :: Property
 prop_rnf =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     rnf a == ()
@@ -799,6 +892,7 @@
   Hashable
 --------------------------------------------------------------------}
 
+prop_hash :: Property
 prop_hash =
   forAll arbitrary $ \(a :: IntervalMap Rational Integer) ->
     hash a `seq` True
@@ -807,6 +901,7 @@
   Data
 ------------------------------------------------------------------ -}
 
+case_Data :: Assertion
 case_Data = everywhere f i @?= (IML.singleton (1 <=..<= 2) 3 :: IntervalMap Integer Integer)
   where
     i :: IntervalMap Integer Integer
@@ -819,6 +914,9 @@
   Generators
 --------------------------------------------------------------------}
 
+instance Arbitrary Interval.Boundary where
+  arbitrary = arbitraryBoundedEnum
+
 instance Arbitrary r => Arbitrary (Extended r) where
   arbitrary =
     oneof
@@ -839,4 +937,5 @@
 ------------------------------------------------------------------------
 -- Test harness
 
+intervalMapTestGroup :: TestTree
 intervalMapTestGroup = $(testGroupGenerator)
diff --git a/test/TestIntervalRelation.hs b/test/TestIntervalRelation.hs
new file mode 100644
--- /dev/null
+++ b/test/TestIntervalRelation.hs
@@ -0,0 +1,154 @@
+{-# LANGUAGE ScopedTypeVariables, TemplateHaskell #-}
+module TestIntervalRelation (intervalRelationTestGroup) where
+
+import Test.Tasty.HUnit
+import Test.Tasty.QuickCheck
+import Test.Tasty.TH
+
+import Data.Interval as I
+import Data.IntervalRelation
+import Data.Ord (Down(..))
+
+import TestInstances
+
+{--------------------------------------------------------------------
+  invert
+--------------------------------------------------------------------}
+
+prop_invert_is_involution a =
+  invert (invert a) === a
+
+prop_invert_inverts_relation =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    relate a b === invert (relate b a)
+
+------------------------------------------------------------------------
+
+case_empty1 =
+  relate (empty :: Interval Rational) empty @?= Equal
+
+prop_empty2 =
+  forAllShrink intervals shrink $ \a -> not (I.null a) ==>
+  relate (empty :: Interval Rational) a === During
+
+prop_empty3 =
+  forAllShrink intervals shrink $ \a -> not (I.null a) ==>
+  relate a (empty :: Interval Rational) === Contains
+
+prop_universal_lt =
+  forAllShrink intervals shrink $ \a -> not (I.null a) ==>
+  forAllShrink intervals shrink $ \b -> not (I.null b) ==>
+    let r = relate a b in counterexample (show r) $
+    if a <! b then r `elem`    [Before, JustBefore]
+              else r `notElem` [Before, JustBefore]
+
+prop_universal_le =
+  forAllShrink intervals shrink $ \a -> not (I.null a) ==>
+  forAllShrink intervals shrink $ \b -> not (I.null b) ==>
+    let r = relate a b in counterexample (show r) $
+    if a <=! b then r `elem`    [Before, JustBefore, Overlaps, Starts, Equal, FinishedBy]
+               else r `notElem` [Before, JustBefore]
+
+prop_universal_eq =
+  forAllShrink intervals shrink $ \a -> not (I.null a) ==>
+  forAllShrink intervals shrink $ \b -> not (I.null b) ==>
+    not (a ==! b) || relate a b == Equal
+
+prop_universal_gt =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a >! b) === (b <! a)
+
+prop_universal_ge =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a >=! b) === (b <=! a)
+
+prop_universal_ne =
+  forAllShrink intervals shrink $ \a -> not (I.null a) ==>
+  forAllShrink intervals shrink $ \b -> not (I.null b) ==>
+    let r = relate a b in counterexample (show r) $
+    if a /=! b then r `elem`    [Before, JustBefore, After, JustAfter]
+               else r `notElem` [Before, JustBefore, After, JustAfter]
+
+------------------------------------------------------------------------
+
+prop_existential_lt =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a <? b) === not (a >=! b)
+
+prop_existential_le =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a <=? b) === not (a >! b)
+
+prop_existential_eq =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a ==? b) === not (a /=! b)
+
+prop_existential_gt =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a >? b) === not (a <=! b)
+
+prop_existential_ge =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a >=? b) === not (a <! b)
+
+prop_existential_ne =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    (a /=? b) === not (a ==! b)
+
+------------------------------------------------------------------------
+
+prop_before =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    let r = relate a b in counterexample (show r) $
+    (r == Before) === (a <! b && not (isConnected a b))
+
+prop_just_before =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    let r = relate a b in counterexample (show r) $
+    (r == JustBefore) === (a <! b && isConnected a b && not (I.null a) && not (I.null b))
+
+prop_overlaps =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    let r = relate a b in counterexample (show r) $
+    (r == Overlaps) === (not (I.null (intersection a b)) && fmap Down (lowerBound' a) < fmap Down (lowerBound' b) && upperBound' a < upperBound' b)
+
+prop_starts =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    let r = relate a b in counterexample (show r) $
+    (r == Starts) === (isProperSubsetOf a b && lowerBound' a == lowerBound' b)
+
+prop_during =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    let r = relate a b in counterexample (show r) $
+    (r == During) === (isProperSubsetOf a b && lowerBound' a /= lowerBound' b && upperBound' a /= upperBound' b)
+
+prop_finishes =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    let r = relate a b in counterexample (show r) $
+    (r == Finishes) === (isProperSubsetOf a b && upperBound' a == upperBound' b)
+
+prop_equal =
+  forAllShrink intervals shrink $ \a ->
+  forAllShrink intervals shrink $ \b ->
+    let r = relate a b in counterexample (show r) $
+    (r == Equal) === (a == b)
+
+------------------------------------------------------------------------
+-- Test harness
+
+intervalRelationTestGroup = $(testGroupGenerator)
diff --git a/test/TestIntervalSet.hs b/test/TestIntervalSet.hs
--- a/test/TestIntervalSet.hs
+++ b/test/TestIntervalSet.hs
@@ -1,12 +1,16 @@
-{-# LANGUAGE TemplateHaskell, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, TemplateHaskell, ScopedTypeVariables #-}
 module TestIntervalSet (intervalSetTestGroup) where
 
+#ifdef MIN_VERSION_lattices
 import qualified Algebra.Lattice as L
+#endif
 import Control.Applicative ((<$>))
+import Control.Arrow (first)
 import Control.DeepSeq
 import Control.Monad
 import Data.Generics.Schemes
 import Data.Hashable
+import qualified Data.List as L
 import Data.Maybe
 import Data.Monoid
 import Data.Ratio
@@ -60,6 +64,9 @@
   forAll arbitrary $ \r1 ->
     not $ IntervalSet.null $ fromRational (r1::Rational)
 
+case_singleton_1 =
+  IntervalSet.singleton Interval.empty @?= (IntervalSet.empty :: IntervalSet Rational)
+
 {--------------------------------------------------------------------
   complement
 --------------------------------------------------------------------}
@@ -80,6 +87,10 @@
   fromList
 --------------------------------------------------------------------}
 
+case_fromList_minus_one_to_one_without_zero = xs @?= xs
+  where
+    xs = show (IntervalSet.fromList [ (-1 <..< 0 :: Interval Rational), 0 <..<1 ])
+
 case_fromList_connected =
   IntervalSet.fromList [ (0 <=..< 1 :: Interval Rational), 1 <=..<2 ]
   @?= IntervalSet.fromList [ 0 <=..<2 ]
@@ -108,6 +119,22 @@
   IntervalSet.insert (1 <=..< 2 :: Interval Rational) (IntervalSet.fromList [ 0 <=..< 1, 2 <=..< 3 ])
   @?= IntervalSet.singleton (0 <=..< 3)
 
+case_insert_zero =
+  IntervalSet.insert zero (IntervalSet.complement $ IntervalSet.singleton zero) @?= IntervalSet.whole
+  where
+    zero :: Interval Rational
+    zero = 0 <=..<= 0
+
+case_insert_zero_negative =
+  IntervalSet.insert zero negative @?= nonPositive
+  where
+    zero :: Interval Rational
+    zero = 0 <=..<= 0
+    negative :: IntervalSet Rational
+    negative = IntervalSet.singleton $ NegInf <..< 0
+    nonPositive :: IntervalSet Rational
+    nonPositive = IntervalSet.singleton $ NegInf <..<= 0
+
 {--------------------------------------------------------------------
   delete
 --------------------------------------------------------------------}
@@ -160,11 +187,22 @@
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     IntervalSet.intersection a IntervalSet.empty == IntervalSet.empty
 
+prop_intersection_isSubsetOf_integer =
+  forAll arbitrary $ \(a :: IntervalSet Integer) ->
+  forAll arbitrary $ \b ->
+    IntervalSet.isSubsetOf (IntervalSet.intersection a b) a
+
 prop_intersection_isSubsetOf =
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
   forAll arbitrary $ \b ->
     IntervalSet.isSubsetOf (IntervalSet.intersection a b) a
 
+prop_intersection_isSubsetOf_equiv_integer =
+  forAll arbitrary $ \(a :: IntervalSet Integer) ->
+  forAll arbitrary $ \b ->
+    (IntervalSet.intersection a b == a)
+    == IntervalSet.isSubsetOf a b
+
 prop_intersection_isSubsetOf_equiv =
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
   forAll arbitrary $ \b ->
@@ -211,11 +249,22 @@
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     IntervalSet.union a IntervalSet.whole == IntervalSet.whole
 
+prop_union_isSubsetOf_integer =
+  forAll arbitrary $ \(a :: IntervalSet Integer) ->
+  forAll arbitrary $ \b ->
+    IntervalSet.isSubsetOf a (IntervalSet.union a b)
+
 prop_union_isSubsetOf =
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
   forAll arbitrary $ \b ->
     IntervalSet.isSubsetOf a (IntervalSet.union a b)
 
+prop_union_isSubsetOf_equiv_integer =
+  forAll arbitrary $ \(a :: IntervalSet Integer) ->
+  forAll arbitrary $ \b ->
+    (IntervalSet.union a b == b)
+    == IntervalSet.isSubsetOf a b
+
 prop_union_isSubsetOf_equiv =
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
   forAll arbitrary $ \b ->
@@ -244,6 +293,10 @@
   span
 --------------------------------------------------------------------}
 
+prop_span_integer =
+  forAll arbitrary $ \(a :: IntervalSet Integer) ->
+    a `IntervalSet.isSubsetOf` IntervalSet.singleton (IntervalSet.span a)
+
 prop_span =
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     a `IntervalSet.isSubsetOf` IntervalSet.singleton (IntervalSet.span a)
@@ -251,18 +304,98 @@
 case_span_empty =
   IntervalSet.span IntervalSet.empty @?= (Interval.empty :: Interval Rational)
 
+case_span_whole =
+  IntervalSet.span IntervalSet.whole @?= (Interval.whole :: Interval Rational)
+
+case_span_without_zero =
+  IntervalSet.span (IntervalSet.complement $ IntervalSet.singleton $ 0 <=..<= 0) @?=
+    (Interval.whole :: Interval Rational)
+
+case_span_1 =
+  IntervalSet.span (IntervalSet.fromList [0 <=..< 10, 20 <..< PosInf]) @?=
+    0 <=..< PosInf
+
 {--------------------------------------------------------------------
   member
 --------------------------------------------------------------------}
 
+prop_member =
+  forAll arbitrary $ \(r :: Rational) (is :: IntervalSet Rational) ->
+    r `IntervalSet.member` is ==
+      any (r `Interval.member`) (IntervalSet.toList is)
+
+prop_member_empty =
+  forAll arbitrary $ \(r :: Rational) ->
+    not (r `IntervalSet.member` IntervalSet.empty)
+
+prop_member_singleton =
+  forAll arbitrary $ \(r1 :: Rational) (r2 :: Rational) ->
+    r1 `IntervalSet.member` IntervalSet.singleton (Interval.singleton r2) ==
+      (r1 == r2)
+
 prop_notMember_empty =
-  forAll arbitrary $ \(r::Rational) ->
+  forAll arbitrary $ \(r :: Rational) ->
     r `IntervalSet.notMember` IntervalSet.empty
 
 {--------------------------------------------------------------------
   isSubsetOf
 --------------------------------------------------------------------}
 
+case_isSubsetOf_1 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (NegInf <..<= 2)
+    b = IntervalSet.singleton (NegInf <..<= 1)
+
+case_isSubsetOf_2 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (1 <=..< PosInf)
+    b = IntervalSet.singleton (2 <=..< PosInf)
+
+case_isSubsetOf_3 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (0 <=..< 1)
+    b = IntervalSet.singleton (2 <..< PosInf)
+
+case_isSubsetOf_4 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (0 <=..<= 1)
+    b = IntervalSet.singleton (2 <..< PosInf)
+
+case_isSubsetOf_5 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (0 <..< 1)
+    b = IntervalSet.singleton (2 <=..< PosInf)
+
+case_isSubsetOf_6 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (0 <..< 1)
+    b = IntervalSet.singleton (2 <..< PosInf)
+
+case_isSubsetOf_7 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (0 <..<= 1)
+    b = IntervalSet.fromList [NegInf <..<= 0, 1 <=..< PosInf]
+
+case_isSubsetOf_8 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (0 <..< 1)
+    b = IntervalSet.fromList [NegInf <..< 0, 1 <=..< PosInf]
+
+case_isSubsetOf_9 = IntervalSet.isSubsetOf a b @?= True
+  where
+    a = IntervalSet.singleton (-3 <..< 1)
+    b = IntervalSet.singleton (-4 <..< 2)
+
+case_isSubsetOf_10 = IntervalSet.isSubsetOf a b @?= True
+  where
+    a = IntervalSet.singleton (14 <=..<= 16)
+    b = IntervalSet.singleton (-8 <=..< PosInf)
+
+case_isSubsetOf_11 = IntervalSet.isSubsetOf a b @?= False
+  where
+    a = IntervalSet.singleton (0 <=..<= 1)
+    b = IntervalSet.fromList [0 <=..<= 0, 1 <=..< PosInf]
+
 prop_isSubsetOf_reflexive =
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     a `IntervalSet.isSubsetOf` a
@@ -271,6 +404,14 @@
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     not (a `IntervalSet.isProperSubsetOf` a)
 
+prop_isSubsetOf_empty =
+  forAll arbitrary $ \(a :: IntervalSet Rational) ->
+    IntervalSet.empty `IntervalSet.isSubsetOf` a
+
+prop_isSubsetOf_whole =
+  forAll arbitrary $ \(a :: IntervalSet Rational) ->
+    a `IntervalSet.isSubsetOf` IntervalSet.whole
+
 {--------------------------------------------------------------------
   toList / fromList
 --------------------------------------------------------------------}
@@ -279,6 +420,15 @@
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     IntervalSet.fromList (IntervalSet.toList a) == a
 
+prop_fromAscList_toAscList_id =
+  forAll arbitrary $ \(a :: IntervalSet Rational) ->
+    IntervalSet.fromAscList (IntervalSet.toAscList a) == a
+
+case_toDescList_simple = xs @?= xs
+  where
+    xs = IntervalSet.toDescList $
+      IntervalSet.fromList [NegInf <..< Finite (-1), Finite 1 <..< PosInf]
+
 prop_toAscList_toDescList =
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     IntervalSet.toDescList a == reverse (IntervalSet.toAscList a)
@@ -295,6 +445,8 @@
   Lattice
 --------------------------------------------------------------------}
 
+#ifdef MIN_VERSION_lattices
+
 prop_Lattice_Leq_welldefined =
   forAll arbitrary $ \(a :: IntervalSet Rational) (b :: IntervalSet Rational) ->
     a `L.meetLeq` b == a `L.joinLeq` b
@@ -307,6 +459,14 @@
   forAll arbitrary $ \(a :: IntervalSet Rational) ->
     L.bottom `L.joinLeq` a
 
+#else
+
+prop_Lattice_Leq_welldefined = True
+prop_top                     = True
+prop_bottom                  = True
+
+#endif
+
 {--------------------------------------------------------------------
   Show / Read
 --------------------------------------------------------------------}
@@ -443,9 +603,8 @@
         d = fromIntegral (denominator r)
     in fromRational n / fromRational d == (fromRational (r::Rational) :: IntervalSet Rational)
 
-prop_recip_zero =
-  forAll arbitrary $ \(a :: IntervalSet Rational) ->
-    0 `IntervalSet.member` a ==> recip a == IntervalSet.whole
+prop_recip (a :: IntervalSet Rational) =
+  recip (recip a) === IntervalSet.delete (Interval.singleton 0) a
 
 {- ------------------------------------------------------------------
   Data
@@ -463,32 +622,38 @@
   Generators
 --------------------------------------------------------------------}
 
+instance Arbitrary Interval.Boundary where
+  arbitrary = arbitraryBoundedEnum
+
 instance Arbitrary r => Arbitrary (Extended r) where
   arbitrary =
     oneof
-    [ return NegInf
-    , return PosInf
-    , liftM Finite arbitrary
+    [ pure NegInf
+    , pure PosInf
+    , fmap Finite arbitrary
     ]
 
 instance (Arbitrary r, Ord r) => Arbitrary (Interval r) where
-  arbitrary = do
-    lb <- arbitrary
-    ub <- arbitrary
-    return $ Interval.interval lb ub
+  arbitrary =
+    Interval.interval <$> arbitrary <*> arbitrary
 
 instance (Arbitrary r, Ord r) => Arbitrary (IntervalSet r) where
-  arbitrary =  do
+  arbitrary = do
+    tabStops <- L.sort <$> arbitrary
+    let is = IntervalSet.fromList $ go tabStops
     b <- arbitrary
-    if b then
-      return IntervalSet.whole
-    else do
-      xs <- IntervalSet.fromList <$> listOf arbitrary
-      b2 <- arbitrary
-      if b2 then
-        return xs
-      else
-        return $ IntervalSet.complement xs
+    pure $ if b then is else IntervalSet.complement is
+    where
+      go [] = []
+      go [(x, LT)] = [Finite x <..< PosInf]
+      go [(x, GT)] = [Finite x <=..< PosInf]
+      go ((x, EQ) : rest) = Interval.singleton x : go rest
+      go ((x, LT) : (y, LT) : rest) = (Finite x <..< Finite y) : go rest
+      go ((x, LT) : (y, GT) : rest) = (Finite x <..<= Finite y) : go rest
+      go ((x, GT) : (y, LT) : rest) = (Finite x <=..< Finite y) : go rest
+      go ((x, GT) : (y, GT) : rest) = (Finite x <=..<= Finite y) : go rest
+      go ((x, LT) : (y, EQ) : rest) = (Finite x <..< Finite y) : go ((y, LT) : rest)
+      go ((x, GT) : (y, EQ) : rest) = (Finite x <=..< Finite y) : go ((y, LT) : rest)
 
 intervals :: Gen (Interval Rational)
 intervals = arbitrary
diff --git a/test/TestSuite.hs b/test/TestSuite.hs
--- a/test/TestSuite.hs
+++ b/test/TestSuite.hs
@@ -2,6 +2,7 @@
 
 import TestInterval
 import TestIntervalMap
+import TestIntervalRelation
 import TestIntervalSet
 import TestIntegerInterval
 import Test.Tasty
@@ -10,6 +11,7 @@
 main = defaultMain $ testGroup "data-interval test suite"
   [ intervalTestGroup
   , intervalMapTestGroup
+  , intervalRelationTestGroup
   , intervalSetTestGroup
   , integerIntervalTestGroup
   ]