diff --git a/CHANGELOG.md b/CHANGELOG.md
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,5 +1,15 @@
 # Revision history for interval-patterns
 
+## 0.7.2
+
+* fix sign of result in `Data.Timeframe.duration`
+* generalize `within` and `thickness` to Levitated
+
+## 0.7.1
+
+* instances `Hashable` and `NFData` for `Interval`
+* relax constraint on `Data.Interval.Layers.thickness` to `Semigroup`
+
 ## 0.7.0.3
 
 * update `lattice` version range to build on new stackage LTS
diff --git a/interval-patterns.cabal b/interval-patterns.cabal
--- a/interval-patterns.cabal
+++ b/interval-patterns.cabal
@@ -1,6 +1,6 @@
 cabal-version:      3.0
 name:               interval-patterns
-version:            0.7.0.3
+version:            0.7.2
 author:             Melanie Brown
 synopsis:           Intervals, and monoids thereof
 category:           Algebra, Charts, Data Structures, Math, Statistics
@@ -17,12 +17,14 @@
 common interval-patterns
   build-depends:
     , base         >=4.11    && <5
-    , containers
+    , containers   >=0.6.7   && <0.7
+    , deepseq      >=1.4.8   && <1.6
     , groups       >=0.5.3   && <0.6
+    , hashable     >=1.4.2   && <1.5
     , heaps        >=0.4     && <0.5
     , lattices     >=2.1     && <3
     , semirings    >=0.6     && <0.7
-    , time
+    , time         >=1.9.3   && <1.13
     , time-compat  >=1.9.6.1 && <1.10
 
   default-language:   GHC2021
diff --git a/src/Data/Calendar.hs b/src/Data/Calendar.hs
--- a/src/Data/Calendar.hs
+++ b/src/Data/Calendar.hs
@@ -16,7 +16,7 @@
   totalDuration,
 ) where
 
-import Control.Applicative (liftA2)
+import Algebra.Lattice.Levitated (Levitated (..))
 import Data.Data (Typeable)
 import Data.Foldable (fold)
 import Data.Interval qualified as I
@@ -25,8 +25,8 @@
 import Data.Map.Strict (Map)
 import Data.Map.Strict qualified as Map
 import Data.Maybe (fromMaybe)
-import Data.Semigroup hiding (diff)
-import Data.Time.Compat
+import Data.Semigroup (Sum (..))
+import Data.Time.Compat (NominalDiffTime, UTCTime, diffUTCTime)
 import Data.Timeframe
 
 -- | An 'Event' is a collection of 'Timeframe's that keeps track of
@@ -62,9 +62,12 @@
   deriving (Eq, Ord, Show, Typeable)
 
 instance (Ord ev, Ord n, Num n) => Semigroup (Calendar ev n) where
+  (<>) ::
+    (Ord ev, Ord n, Num n) => Calendar ev n -> Calendar ev n -> Calendar ev n
   Calendar a <> Calendar b = Calendar (Map.unionWith (<>) a b)
 
 instance (Ord ev, Ord n, Num n) => Monoid (Calendar ev n) where
+  mempty :: (Ord ev, Ord n, Num n) => Calendar ev n
   mempty = Data.Calendar.empty
 
 -- | The empty 'Calendar'.
@@ -80,7 +83,8 @@
 calendar ev tf = singleton ev (Layers.singleton tf 1)
 
 -- | Insert an 'Event' of the given sort into a 'Calendar'.
-insert :: (Ord ev, Ord n, Num n) => ev -> Event n -> Calendar ev n -> Calendar ev n
+insert ::
+  (Ord ev, Ord n, Num n) => ev -> Event n -> Calendar ev n -> Calendar ev n
 insert ev cvg (Calendar c) = Calendar (Map.insertWith (<>) ev cvg c)
 
 -- |
@@ -95,7 +99,8 @@
 (!) :: (Ord ev, Ord n, Num n) => Calendar ev n -> ev -> Event n
 Calendar c ! ev = fromMaybe mempty (c Map.!? ev)
 
-toList :: (Ord ev, Ord n, Num n) => Calendar ev n -> [(ev, [(Interval UTCTime, n)])]
+toList ::
+  (Ord ev, Ord n, Num n) => Calendar ev n -> [(ev, [(Interval UTCTime, n)])]
 toList (Calendar c) = fmap (fmap (fmap getSum) . Layers.toList) <$> Map.assocs c
 
 -- |
@@ -103,12 +108,16 @@
 -- at the given 'UTCTime' on this 'Calendar'?
 happeningAt :: (Ord ev, Ord n, Num n) => UTCTime -> Calendar ev n -> [(ev, n)]
 happeningAt time (Data.Calendar.toList -> evs) =
-  [(ev, n) | (ev, ns) <- evs, (_, n) <- filter (within time . fst) ns]
+  [ (ev, n)
+  | (ev, ns) <- evs
+  , (_, n) <- filter (within (Levitate time) . fst) ns
+  ]
 
 -- | Consider every kind of event the same, and observe the overall 'Layers'.
 coalesce :: (Ord ev, Ord n, Num n) => Calendar ev n -> Event n
 coalesce (Calendar c) = fold c
 
+-- | Calculate the total length of a particular event across all occurrences.
 totalDuration ::
   forall ev n.
   (Ord ev, Real n) =>
diff --git a/src/Data/Interval.hs b/src/Data/Interval.hs
--- a/src/Data/Interval.hs
+++ b/src/Data/Interval.hs
@@ -99,10 +99,12 @@
 
 import Algebra.Lattice.Levitated (Levitated (..), foldLevitated)
 import Control.Applicative (liftA2)
+import Control.DeepSeq
 import Control.Monad (join)
 import Data.Data
 import Data.Function (on)
 import Data.Functor.Const (Const (Const))
+import Data.Hashable (Hashable (..))
 import Data.Kind (Constraint, Type)
 import Data.List (sort)
 import Data.List.NonEmpty (NonEmpty ((:|)))
@@ -567,6 +569,18 @@
   to :: (Ord x, Generic x) => Rep (Interval x) x1 -> Interval x
   to (Const l :*: Const u) = l ... u
 
+instance (Ord x, Hashable x) => Hashable (Interval x) where
+  hashWithSalt :: (Ord x, Hashable x) => Int -> Interval x -> Int
+  hashWithSalt s = \case
+    l :<->: u -> s `hashWithSalt` (1 :: Int) `hashWithSalt` l `hashWithSalt` u
+    l :|->: u -> s `hashWithSalt` (2 :: Int) `hashWithSalt` l `hashWithSalt` u
+    l :<-|: u -> s `hashWithSalt` (3 :: Int) `hashWithSalt` l `hashWithSalt` u
+    l :|-|: u -> s `hashWithSalt` (4 :: Int) `hashWithSalt` l `hashWithSalt` u
+
+instance (Ord x, NFData x) => NFData (Interval x) where
+  rnf :: (Ord x, NFData x) => Interval x -> ()
+  rnf (x :---: y) = x `seq` y `seq` ()
+
 -- | Since the 'Ord' constraints on the constructors for 'Interval'
 -- prevent it from being a 'Functor', this will have to suffice.
 imap :: (Ord x, Ord y) => (x -> y) -> Interval x -> Interval y
@@ -818,8 +832,8 @@
 hulls (i :| j : is) = hulls (hull i j :| is)
 
 -- | Test whether a point is contained in the interval.
-within :: (Ord x) => x -> Interval x -> Bool
-within (Levitate -> x) = \case
+within :: (Ord x) => Levitated x -> Interval x -> Bool
+within x = \case
   l :<->: u -> l < x && x < u
   l :<-|: u -> l < x && x <= u
   l :|->: u -> l <= x && x < u
diff --git a/src/Data/Interval/Borel.hs b/src/Data/Interval/Borel.hs
--- a/src/Data/Interval/Borel.hs
+++ b/src/Data/Interval/Borel.hs
@@ -25,9 +25,13 @@
 ) where
 
 import Algebra.Heyting (Heyting ((==>)))
-import Algebra.Lattice
-import Control.Arrow ((>>>))
-import Data.Data
+import Algebra.Lattice (
+  BoundedJoinSemiLattice (..),
+  BoundedMeetSemiLattice (..),
+  Lattice (..),
+ )
+import Algebra.Lattice.Levitated (Levitated (..))
+import Data.Data (Data, Typeable)
 import Data.Foldable (fold)
 import Data.Functor ((<&>))
 import Data.Interval (Interval)
@@ -56,31 +60,47 @@
   deriving (Eq, Ord, Show, Generic, Typeable, Data)
 
 instance (Ord x) => Semigroup (Borel x) where
+  (<>) :: (Ord x) => Borel x -> Borel x -> Borel x
   Borel is <> Borel js = Borel (unionsSet (is <> js))
 
 instance (Ord x) => Monoid (Borel x) where
+  mempty :: (Ord x) => Borel x
   mempty = Borel mempty
 
 instance (Ord x, Lattice x) => Lattice (Borel x) where
+  (\/) :: (Ord x, Lattice x) => Borel x -> Borel x -> Borel x
   (\/) = union
+
+  (/\) :: (Ord x, Lattice x) => Borel x -> Borel x -> Borel x
   (/\) = intersection
 
 instance (Ord x, Lattice x) => BoundedMeetSemiLattice (Borel x) where
+  top :: (Ord x, Lattice x) => Borel x
   top = whole
 
 instance (Ord x, Lattice x) => BoundedJoinSemiLattice (Borel x) where
+  bottom :: (Ord x, Lattice x) => Borel x
   bottom = mempty
 
 instance (Ord x, Lattice x) => Heyting (Borel x) where
+  (==>) :: (Ord x, Lattice x) => Borel x -> Borel x -> Borel x
   x ==> y = complement x \/ y
 
 instance (Ord x, Lattice x) => Semiring (Borel x) where
+  plus :: (Ord x, Lattice x) => Borel x -> Borel x -> Borel x
   plus = symmetricDifference
+
+  times :: (Ord x, Lattice x) => Borel x -> Borel x -> Borel x
   times = intersection
+
+  zero :: (Ord x, Lattice x) => Borel x
   zero = mempty
+
+  one :: (Ord x, Lattice x) => Borel x
   one = whole
 
 instance (Ord x, Lattice x) => Ring (Borel x) where
+  negate :: (Ord x, Lattice x) => Borel x -> Borel x
   negate = complement
 
 -- | Consider the 'Borel' set identified by a list of 'Interval's.
@@ -118,12 +138,10 @@
 -- Completely remove an 'Interval' from a 'Borel' set.
 -- Essentially the opposite of 'truncate'.
 remove :: (Ord x) => Interval x -> Borel x -> Borel x
-remove i (Borel is) =
-  flip foldMap is $
-    (I.\\ i) >>> \case
-      Nothing -> mempty
-      Just (One j) -> borel [j]
-      Just (Two j k) -> borel [j, k]
+remove i (Borel is) = flip foldMap is $ flip (.) (I.\\ i) \case
+  Nothing -> mempty
+  Just (One j) -> borel [j]
+  Just (Two j k) -> borel [j, k]
 
 -- | Flipped infix version of 'remove'.
 (\-) :: (Ord x) => Borel x -> Interval x -> Borel x
@@ -131,7 +149,7 @@
 
 -- | Is this point 'I.within' any connected component of the 'Borel' set?
 member :: (Ord x) => x -> Borel x -> Bool
-member x (Borel is) = any (I.within x) is
+member x (Borel is) = any (I.within (Levitate x)) is
 
 -- | Is this point not 'I.within' any connected component of the 'Borel' set?
 notMember :: (Ord x) => x -> Borel x -> Bool
diff --git a/src/Data/Interval/Layers.hs b/src/Data/Interval/Layers.hs
--- a/src/Data/Interval/Layers.hs
+++ b/src/Data/Interval/Layers.hs
@@ -29,8 +29,15 @@
 import Data.Group (Group (..))
 import Data.Heap (Heap)
 import Data.Heap qualified as Heap
-import Data.Interval (Adjacency (..), Interval, OneOrTwo (..), pattern Whole, pattern (:---:), pattern (:<>:))
-import Data.Interval qualified as I
+import Data.Interval (
+  Adjacency (..),
+  Interval,
+  OneOrTwo (..),
+  pattern Whole,
+  pattern (:---:),
+  pattern (:|-|:),
+ )
+import Data.Interval qualified as Interval
 import Data.Interval.Borel (Borel)
 import Data.Interval.Borel qualified as Borel
 import Data.Map.Strict (Map)
@@ -44,14 +51,20 @@
   deriving (Eq, Ord, Show, Functor, Generic, Typeable, Data)
 
 instance (Ord x, Ord y, Semigroup y) => Semigroup (Layers x y) where
+  (<>) :: (Ord x, Ord y, Semigroup y) => Layers x y -> Layers x y -> Layers x y
   Layers s1 <> Layers s2 =
-    let s = Map.toAscList $ Map.unionWith (<>) s1 s2
-     in Layers $ Map.fromList (nestingsAsc $ Heap.fromList s)
+    Layers
+      . Map.fromAscList
+      . nestingsAsc
+      . Heap.fromList
+      $ Map.toAscList (Map.unionWith (<>) s1 s2)
 
 instance (Ord x, Ord y, Semigroup y) => Monoid (Layers x y) where
+  mempty :: (Ord x, Ord y, Semigroup y) => Layers x y
   mempty = Layers mempty
 
 instance (Ord x, Ord y, Group y) => Group (Layers x y) where
+  invert :: (Ord x, Ord y, Group y) => Layers x y -> Layers x y
   invert (Layers s) = Layers (fmap invert s)
 
 -- | A blank canvas.
@@ -101,15 +114,11 @@
 
 -- | Completely remove an 'Interval' from the 'Layers'.
 remove :: (Ord x, Ord y, Semigroup y) => Interval x -> Layers x y -> Layers x y
-remove ix (Layers s) =
-  Map.foldlWithKey'
-    ( \acc jx y -> case jx I.\\ ix of
-        Nothing -> acc
-        Just (One kx) -> acc <> singleton kx y
-        Just (Two kx lx) -> acc <> fromList [(kx, y), (lx, y)]
-    )
-    empty
-    s
+remove ix (Layers s) = flip (`Map.foldlWithKey'` empty) s \acc jx y ->
+  acc <> case jx Interval.\\ ix of
+    Nothing -> mempty
+    Just (One kx) -> singleton kx y
+    Just (Two kx lx) -> fromList [(kx, y), (lx, y)]
 
 -- | Fliped infix version of 'remove'.
 (\-) :: (Ord x, Ord y, Semigroup y) => Layers x y -> Interval x -> Layers x y
@@ -125,15 +134,11 @@
   foldr (uncurry (flip dig)) layers (Map.toAscList s)
 
 -- | Restrict the range of the 'Layers' to the given 'Interval'.
-truncate :: (Ord x, Ord y, Semigroup y) => Interval x -> Layers x y -> Layers x y
+truncate ::
+  (Ord x, Ord y, Semigroup y) => Interval x -> Layers x y -> Layers x y
 truncate ix (Layers s) =
-  Map.foldlWithKey'
-    ( \acc jx y -> case I.intersect ix jx of
-        Nothing -> acc
-        Just x -> insert x y acc
-    )
-    empty
-    s
+  flip (`Map.foldlWithKey'` empty) s \acc jx y ->
+    maybe id (`insert` y) (Interval.intersect ix jx) acc
 
 -- | Flipped infix version of 'truncate'.
 (\=) :: (Ord x, Ord y, Semigroup y) => Layers x y -> Interval x -> Layers x y
@@ -154,40 +159,38 @@
   let Layers (Map.assocs -> s) = layers \= ix
       f (jx, y) maccum = do
         acc <- maccum
-        d <- I.measuring diff jx
+        d <- Interval.measuring diff jx
         pure $ acc + d * hgt y
    in foldr f (Just 0) s
 
 -- | Get the thickness of the 'Layers' at a point.
-thickness :: (Ord x, Monoid y) => x -> Layers x y -> y
-thickness x (Layers s) = case Map.lookupLE (x :<>: x) s of
-  Just (ix, y) | x `I.within` ix -> y
-  _ -> mempty
+thickness :: (Ord x, Semigroup y) => Levitated x -> Layers x y -> Maybe y
+thickness x (Layers s) = case Map.lookupLE (x :|-|: x) s of
+  Just (ix, y) | x `Interval.within` ix -> Just y
+  _ -> Nothing
 
 -- | Where and how thick is the thickest 'Interval'?
 thickest :: (Ord x, Ord y) => Layers x y -> Maybe (Interval x, y)
 thickest (Layers s) =
-  Map.foldlWithKey'
-    ( \acc ix y -> Just $ case acc of
-        Nothing -> (ix, y)
-        Just (ix', y') -> if y > y' then (ix, y) else (ix', y')
-    )
-    Nothing
-    s
+  flip (`Map.foldlWithKey'` Nothing) s \acc ix y -> Just case acc of
+    Nothing -> (ix, y)
+    Just (_, y') | y > y' -> (ix, y)
+    Just (ix', y') -> (ix', y')
 
 -- | Convert the 'Layers' into a list of beginning-points and heights,
 -- that define a step function piecewise.
 toStepFunction :: (Ord x, Ord y, Monoid y) => Layers x y -> [(Levitated x, y)]
-toStepFunction s = g (Data.Interval.Layers.toList $ baseline mempty s)
+toStepFunction = go . Data.Interval.Layers.toList
  where
-  g [(il :---: iu, iy), (j@(jl :---: Top), jy)]
-    | iu == jl = (il, iy) : g [(j, jy)]
-    | otherwise = (il, iy) : (iu, mempty) : g [(j, jy)]
-  g ((il :---: iu, iy) : (j@(jl :---: _), jy) : is)
-    | iu == jl = (il, iy) : g ((j, jy) : is)
-    | otherwise = (il, iy) : (iu, mempty) : g ((j, jy) : is)
-  g [] = []
-  g [(il :---: iu, iy)] = [(il, iy), (iu, mempty)]
+  go = \case
+    [(il :---: iu, iy), (j@(jl :---: Top), jy)]
+      | iu == jl -> (il, iy) : go [(j, jy)]
+      | otherwise -> (il, iy) : (iu, mempty) : go [(j, jy)]
+    (il :---: iu, iy) : (j@(jl :---: _), jy) : is
+      | iu == jl -> (il, iy) : go ((j, jy) : is)
+      | otherwise -> (il, iy) : (iu, mempty) : go ((j, jy) : is)
+    [(il :---: iu, iy)] -> [(il, iy), (iu, mempty)]
+    [] -> []
 
 nestings ::
   (Ord x, Ord y, Semigroup y) =>
@@ -201,35 +204,43 @@
   [(Interval x, y)]
 nestingsAsc heap = case firstTwo of
   Nothing -> Foldable.toList heap
-  Just ((i', iy), (j', jy), js) -> case I.adjacency i' j' of
+  Just ((i', iy), (j', jy), js) -> case Interval.adjacency i' j' of
     Before i j -> (i, iy) : nestingsAsc (Heap.insert (j, jy) js)
     Meets i j k ->
       (i, iy) : nestingsAsc (Heap.fromList [(j, iy <> jy), (k, jy)] <> js)
     Overlaps i j k ->
-      nestingsAsc $
-        Heap.fromList [(i, iy), (j, iy <> jy), (k, jy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, iy), (j, iy <> jy), (k, jy)]
+        <> js
     Starts i j ->
-      nestingsAsc $
-        Heap.fromList [(i, iy <> jy), (j, jy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, iy <> jy), (j, jy)]
+        <> js
     During i j k ->
-      nestingsAsc $
-        Heap.fromList [(i, jy), (j, iy <> jy), (k, jy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, jy), (j, iy <> jy), (k, jy)]
+        <> js
     Finishes i j ->
-      nestingsAsc $
-        Heap.fromList [(i, iy), (j, iy <> jy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, iy), (j, iy <> jy)]
+        <> js
     Identical i -> nestingsAsc (Heap.insert (i, iy <> jy) js)
     FinishedBy i j ->
-      nestingsAsc $
-        Heap.fromList [(i, iy), (j, iy <> jy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, iy), (j, iy <> jy)]
+        <> js
     Contains i j k ->
-      nestingsAsc $
-        Heap.fromList [(i, iy), (j, iy <> jy), (k, iy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, iy), (j, iy <> jy), (k, iy)]
+        <> js
     StartedBy i j ->
-      nestingsAsc $
-        Heap.fromList [(i, iy <> jy), (j, iy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, iy <> jy), (j, iy)]
+        <> js
     OverlappedBy i j k ->
-      nestingsAsc $
-        Heap.fromList [(i, jy), (j, iy <> jy), (k, iy)] <> js
+      nestingsAsc
+        $ Heap.fromList [(i, jy), (j, iy <> jy), (k, iy)]
+        <> js
     MetBy i j k ->
       (i, jy) : nestingsAsc (Heap.fromList [(j, iy <> jy), (k, iy)] <> js)
     After i j -> (i, jy) : nestingsAsc (Heap.insert (j, iy) js)
diff --git a/src/Data/Timeframe.hs b/src/Data/Timeframe.hs
--- a/src/Data/Timeframe.hs
+++ b/src/Data/Timeframe.hs
@@ -30,4 +30,4 @@
    in localTimeframeAt tz t1 t2
 
 duration :: Timeframe -> Maybe NominalDiffTime
-duration = measuring diffUTCTime
+duration = measuring (flip diffUTCTime)
diff --git a/tests/Main.hs b/tests/Main.hs
--- a/tests/Main.hs
+++ b/tests/Main.hs
@@ -15,6 +15,8 @@
   pattern (:||:),
  )
 import Data.Interval.Borel qualified as Borel
+import Data.Interval.Layers qualified as Layers
+import Data.Semigroup
 import GHC.TypeNats
 import Test.Hspec
 import Test.QuickCheck
@@ -24,10 +26,10 @@
   Ints n x = Int -> Ints (n - 1) x
 
 main :: IO ()
-main = hspec $ do
-  describe "smart constructors" $ do
-    it "orient finite intervals" $ do
-      property @(Ints 2 _) $ \x y -> do
+main = hspec do
+  describe "smart constructors" do
+    it "orient finite intervals" do
+      property @(Ints 2 _) \x y -> do
         if x <= y
           then do
             (x :<>: y) `shouldBe` (x :<>: y)
@@ -48,13 +50,13 @@
             (Levitate x :<-|: Levitate y) `shouldBe` (Levitate y :|->: Levitate x)
             (Levitate x :|-|: Levitate y) `shouldBe` (Levitate y :|-|: Levitate x)
 
-    it "orient infinite intervals" $ do
+    it "orient infinite intervals" do
       (Top :<->: Bottom) `shouldBe` (Bottom :<->: Top :: Interval Int)
       (Top :|->: Bottom) `shouldBe` (Bottom :<-|: Top :: Interval Int)
       (Top :<-|: Bottom) `shouldBe` (Bottom :|->: Top :: Interval Int)
       (Top :|-|: Bottom) `shouldBe` (Bottom :|-|: Top :: Interval Int)
 
-    it "close point intervals" $ do
+    it "close point intervals" do
       property @(Int -> _) $ \x -> do
         (x :<>: x) `shouldBe` (x :||: x)
         (x :|>: x) `shouldBe` (x :||: x)
@@ -65,15 +67,23 @@
         (Levitate x :<-|: Levitate x) `shouldBe` (Levitate x :|-|: Levitate x)
         (Levitate x :|-|: Levitate x) `shouldBe` (Levitate x :|-|: Levitate x)
 
-  describe "Borel intervals" $ do
-    it "(<>) is commutative" $ do
-      property @(Ints 4 _) $ \a b x y -> do
+  describe "Borel intervals" do
+    it "(<>) is commutative" do
+      property @(Ints 4 _) \a b x y -> do
         let abxy = Borel.singleton (a :<>: b) <> Borel.singleton (x :<>: y)
             xyab = Borel.singleton (x :<>: y) <> Borel.singleton (a :<>: b)
         abxy `shouldBe` xyab
-    it "(<>) is associative" $ do
-      property @(Ints 6 _) $ \a b m n x y -> do
+    it "(<>) is associative" do
+      property @(Ints 6 _) \a b m n x y -> do
         let ab = Borel.singleton (a :<>: b)
             mn = Borel.singleton (m :<>: n)
             xy = Borel.singleton (x :<>: y)
         (ab <> mn) <> xy `shouldBe` ab <> (mn <> xy)
+
+  describe "Layers" do
+    it "(<>) is associative" do
+      property @(Ints 9 _) \a b c d e f x y z -> do
+        let abx = Layers.singleton (a :<>: b) (Sum x)
+            cdy = Layers.singleton (c :||: d) (Sum y)
+            efz = Layers.singleton (e :<>: f) (Sum z)
+        (abx <> cdy) <> efz `shouldBe` abx <> (cdy <> efz)