Data/TreeMap/Strict.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE NamedFieldPuns #-}
   3 {-# LANGUAGE StandaloneDeriving #-}
   4 {-# LANGUAGE RecordWildCards #-}
   5 {-# OPTIONS_GHC -fno-warn-orphans #-}
   6
   7 -- | This module implements a strict 'TreeMap',
   8 -- which is like a 'Map'
   9 -- but whose key is now a 'NonNull' list of 'Map' keys (a 'Path')
  10 -- enabling the possibility to gather mapped values
  11 -- by 'Path' prefixes (inside a 'Node').
  12 module Data.TreeMap.Strict where
  13
  14 import Control.Applicative (Applicative(..))
  15 import Control.DeepSeq (NFData(..))
  16 import Control.Monad (Monad(..))
  17 import Data.Bool
  18 import Data.Data (Data)
  19 import Data.Eq (Eq)
  20 import Data.Foldable (Foldable, foldMap)
  21 import Data.Function (($), (.), const, flip, id)
  22 import Data.Functor (Functor(..), (<$>))
  23 import Data.Map.Strict (Map)
  24 import Data.Maybe (Maybe(..), maybe)
  25 import Data.Monoid (Monoid(..))
  26 import Data.NonNull (NonNull, nuncons, toNullable)
  27 import Data.Ord (Ord(..))
  28 import Data.Semigroup (Semigroup(..))
  29 import Data.Sequences (reverse)
  30 import Data.Traversable (Traversable(..))
  31 import Data.Typeable (Typeable)
  32 import Prelude (Int, Num(..), seq)
  33 import Text.Show (Show(..))
  34 import qualified Data.List as List
  35 import qualified Data.Map.Strict as Map
  36 import qualified Data.NonNull as NonNull
  37 import qualified Data.Strict.Maybe as Strict
  38
  39 -- @Data.Strict@ orphan instances
  40 deriving instance Data x => Data (Strict.Maybe x)
  41 deriving instance Typeable Strict.Maybe
  42 instance Semigroup x => Semigroup (Strict.Maybe x) where
  43         Strict.Just x <> Strict.Just y = Strict.Just (x <> y)
  44         x <> Strict.Nothing = x
  45         Strict.Nothing <> y = y
  46 instance Semigroup x => Monoid (Strict.Maybe x) where
  47         mempty  = Strict.Nothing
  48         mappend = (<>)
  49 instance NFData x => NFData (Strict.Maybe x) where
  50         rnf Strict.Nothing  = ()
  51         rnf (Strict.Just x) = rnf x
  52
  53 -- * Type 'TreeMap'
  54 newtype TreeMap k x
  55  =      TreeMap (Map k (Node k x))
  56  deriving (Data, Eq, Ord, Show, Typeable)
  57
  58 instance (Ord k, Semigroup v) => Semigroup (TreeMap k v) where
  59         (<>) = union (<>)
  60 instance (Ord k, Monoid v) => Monoid (TreeMap k v) where
  61         mempty = empty
  62         mappend = union mappend
  63         -- mconcat = List.foldr mappend mempty
  64 instance Ord k => Functor (TreeMap k) where
  65         fmap f (TreeMap m) = TreeMap $ fmap (fmap f) m
  66 instance Ord k => Foldable (TreeMap k) where
  67         foldMap f (TreeMap m) = foldMap (foldMap f) m
  68 instance Ord k => Traversable (TreeMap k) where
  69         traverse f (TreeMap m) = TreeMap <$> traverse (traverse f) m
  70 instance (Ord k, NFData k, NFData x) => NFData (TreeMap k x) where
  71         rnf (TreeMap m) = rnf m
  72
  73 -- * Type 'Path'
  74
  75 -- | A 'Path' is a non-empty list of 'Map' keys.
  76 type Path k = NonNull [k]
  77
  78 -- | 'Path' constructor.
  79 path :: k -> [k] -> Path k
  80 path = NonNull.ncons
  81
  82 -- | Convenient alias.
  83 (<|) :: k -> [k] -> Path k
  84 (<|) = path
  85
  86 -- * Type 'Node'
  87 data Node k x
  88  =   Node
  89  {   node_size        :: !Int -- ^ The number of non-'Strict.Nothing' 'node_value's reachable from this 'Node'.
  90  ,   node_value       :: !(Strict.Maybe x) -- ^ Some value, or 'Strict.Nothing' if this 'Node' is intermediary.
  91  ,   node_descendants :: !(TreeMap k x) -- ^ Descendants 'Node's.
  92  } deriving (Data, Eq, Ord, Show, Typeable)
  93
  94 instance (Ord k, Semigroup v) => Semigroup (Node k v) where
  95         (<>)
  96          Node{node_value=x0, node_descendants=m0}
  97          Node{node_value=x1, node_descendants=m1} =
  98                 node (x0 <> x1) (union const m0 m1)
  99 instance (Ord k, Semigroup v) => Monoid (Node k v) where
 100         mempty = node Strict.Nothing (TreeMap mempty)
 101         mappend = (<>)
 102         -- mconcat = List.foldr mappend mempty
 103 instance Ord k => Functor (Node k) where
 104         fmap f Node{node_value=x, node_descendants=m, node_size} =
 105                 Node
 106                  { node_value = fmap f x
 107                  , node_descendants = map f m
 108                  , node_size
 109                  }
 110 instance Ord k => Foldable (Node k) where
 111         foldMap f Node{node_value=Strict.Nothing, node_descendants=TreeMap m} =
 112                 foldMap (foldMap f) m
 113         foldMap f Node{node_value=Strict.Just x, node_descendants=TreeMap m} =
 114                 f x `mappend` foldMap (foldMap f) m
 115 instance Ord k => Traversable (Node k) where
 116         traverse f Node{node_value=Strict.Nothing, node_descendants=TreeMap m, node_size} =
 117                 Node node_size <$> pure Strict.Nothing <*> (TreeMap <$> traverse (traverse f) m)
 118         traverse f Node{node_value=Strict.Just x, node_descendants=TreeMap m, node_size} =
 119                 Node node_size <$> (Strict.Just <$> f x) <*> (TreeMap <$> traverse (traverse f) m)
 120 instance (Ord k, NFData k, NFData x) => NFData (Node k x) where
 121         rnf (Node s v d) = rnf s `seq` rnf v `seq` rnf d
 122
 123 node :: Strict.Maybe x -> TreeMap k x -> Node k x
 124 node node_value node_descendants =
 125         Node
 126          { node_value
 127          , node_size =
 128                 size node_descendants +
 129                 Strict.maybe 0 (const 1) node_value
 130          , node_descendants
 131          }
 132
 133 nodeEmpty :: Node k x
 134 nodeEmpty = node Strict.Nothing empty
 135
 136 nodeLookup :: Ord k => [k] -> Node k x -> Strict.Maybe (Node k x)
 137 nodeLookup [] n = Strict.Just n
 138 nodeLookup (k:ks) Node{node_descendants=TreeMap m} =
 139         maybe Strict.Nothing (nodeLookup ks) $
 140         Map.lookup k m
 141
 142 -- * Construct
 143
 144 -- | Return the empty 'TreeMap'.
 145 empty :: TreeMap k x
 146 empty = TreeMap Map.empty
 147
 148 -- | Return a 'TreeMap' only mapping the given 'Path' to the given value.
 149 singleton :: Ord k => Path k -> x -> TreeMap k x
 150 singleton ks x = insert const ks x empty
 151
 152 -- | Return a 'Node' only containing the given value.
 153 leaf :: x -> Node k x
 154 leaf x = node (Strict.Just x) empty
 155
 156 -- | Return the given 'TreeMap' associating the given 'Path' with the given value,
 157 -- merging values if the given 'TreeMap' already associates the given 'Path'
 158 -- with a non-'Strict.Nothing' 'node_value'.
 159 insert :: Ord k => (x -> x -> x) -> Path k -> x -> TreeMap k x -> TreeMap k x
 160 insert merge p x (TreeMap m) =
 161         TreeMap $
 162         case nuncons p of
 163          (k, Nothing) ->
 164                 Map.insertWith (\_ Node{..} -> node
 165                          (Strict.maybe (Strict.Just x) (Strict.Just . merge x) node_value)
 166                          node_descendants)
 167                  k (leaf x) m
 168          (k, Just p') ->
 169                 Map.insertWith (\_ Node{..} -> node node_value $
 170                         insert merge p' x node_descendants)
 171                  k (node Strict.Nothing (insert merge p' x empty)) m
 172
 173 -- | Return a 'TreeMap' associating for each tuple of the given list
 174 -- the 'Path' to the value,
 175 -- merging values of identical 'Path's (in respective order).
 176 fromList :: Ord k => (x -> x -> x) -> [(Path k, x)] -> TreeMap k x
 177 fromList merge = List.foldl (\acc (p, x) -> insert merge p x acc) empty
 178
 179 -- | Return a 'TreeMap' associating for each key and value of the given 'Map'
 180 -- the 'Path' to the value,
 181 -- merging values of identical 'Path's (in respective order).
 182 fromMap :: Ord k => (x -> x -> x) -> Map (Path k) x -> TreeMap k x
 183 fromMap merge = Map.foldlWithKey (\acc p x -> insert merge p x acc) empty
 184
 185 -- * Size
 186
 187 -- | Return the 'Map' in the given 'TreeMap'.
 188 nodes :: TreeMap k x -> Map k (Node k x)
 189 nodes (TreeMap m) = m
 190
 191 -- | Return 'True' iif. the given 'TreeMap' is 'empty'.
 192 null :: TreeMap k x -> Bool
 193 null (TreeMap m) = Map.null m
 194
 195 -- | Return the number of non-'Strict.Nothing' 'node_value's in the given 'TreeMap'.
 196 --
 197 --   * Complexity: O(r) where r is the size of the root 'Map'.
 198 size :: TreeMap k x -> Int
 199 size = Map.foldr ((+) . node_size) 0 . nodes
 200
 201 -- * Find
 202
 203 -- | Return the value (if any) associated with the given 'Path'.
 204 lookup :: Ord k => Path k -> TreeMap k x -> Strict.Maybe x
 205 lookup p (TreeMap m) =
 206         maybe Strict.Nothing nod_val $ Map.lookup k m
 207         where
 208         (k, mp') = nuncons p
 209         nod_val =
 210                 case mp' of
 211                  Nothing -> node_value
 212                  Just p' -> lookup p' . node_descendants
 213
 214 -- | Return the values (if any) associated with the prefixes of the given 'Path' (included).
 215 lookupAlong :: Ord k => Path k -> TreeMap k x -> [x]
 216 lookupAlong p (TreeMap tm) =
 217         go (toNullable p) tm
 218         where
 219                 go :: Ord k => [k] -> Map k (Node k x) -> [x]
 220                 go [] _m = []
 221                 go (k:ks) m =
 222                         case Map.lookup k m of
 223                          Nothing -> []
 224                          Just nod ->
 225                                 Strict.maybe id (:) (node_value nod) $
 226                                 go ks $ nodes (node_descendants nod)
 227
 228 -- | Return the 'Node' (if any) associated with the given 'Path'.
 229 lookupNode :: Ord k => Path k -> TreeMap k x -> Maybe (Node k x)
 230 lookupNode p (TreeMap m) =
 231         case nuncons p of
 232          (k, Nothing) -> Map.lookup k m
 233          (k, Just p') -> Map.lookup k m >>= lookupNode p' . node_descendants
 234
 235 -- * Union
 236
 237 -- | Return a 'TreeMap' associating the same 'Path's as both given 'TreeMap's,
 238 -- merging values (in respective order) when a 'Path' leads
 239 -- to a non-'Strict.Nothing' 'node_value' in both given 'TreeMap's.
 240 union :: Ord k => (x -> x -> x) -> TreeMap k x -> TreeMap k x -> TreeMap k x
 241 union merge (TreeMap tm0) (TreeMap tm1) =
 242         TreeMap $
 243         Map.unionWith
 244          (\Node{node_value=x0, node_descendants=m0}
 245            Node{node_value=x1, node_descendants=m1} ->
 246                 node (Strict.maybe x1 (\x0' -> Strict.maybe (Strict.Just x0') (Strict.Just . merge x0') x1) x0)
 247                  (union merge m0 m1))
 248          tm0 tm1
 249
 250 -- | Return the 'union' of the given 'TreeMap's.
 251 --
 252 -- NOTE: use |List.foldl'| to reduce demand on the control-stack.
 253 unions :: Ord k => (x -> x -> x) -> [TreeMap k x] -> TreeMap k x
 254 unions merge = List.foldl' (union merge) empty
 255
 256 -- foldl' :: (a -> b -> a) -> a -> [b] -> a
 257 -- foldl' f = go
 258 --      where
 259 --              go z []     = z
 260 --              go z (x:xs) = z `seq` go (f z x) xs
 261
 262 -- * Map
 263
 264 -- | Return the given 'TreeMap' with each non-'Strict.Nothing' 'node_value'
 265 -- mapped by the given function.
 266 map :: Ord k => (x -> y) -> TreeMap k x -> TreeMap k y
 267 map f =
 268         TreeMap .
 269         Map.map
 270          (\n@Node{node_value=x, node_descendants=m} ->
 271                 n{ node_value       = fmap f x
 272                  , node_descendants = map f m
 273                  }) .
 274         nodes
 275
 276 -- | Return the given 'TreeMap' with each 'Path' section
 277 -- and each non-'Strict.Nothing' 'node_value'
 278 -- mapped by the given functions.
 279 --
 280 -- WARNING: the function mapping 'Path' sections must be monotonic,
 281 -- like in 'Map.mapKeysMonotonic'.
 282 mapMonotonic :: (Ord k, Ord l) => (k -> l) -> (x -> y) -> TreeMap k x -> TreeMap l y
 283 mapMonotonic fk fx =
 284         TreeMap .
 285         Map.mapKeysMonotonic fk .
 286         Map.map
 287          (\n@Node{node_value=x, node_descendants=m} ->
 288                 n{ node_value       = fmap fx x
 289                  , node_descendants = mapMonotonic fk fx m
 290                  }) .
 291         nodes
 292
 293 -- | Return the given 'TreeMap' with each 'node_value'
 294 -- mapped by the given function supplied with
 295 -- the already mapped 'node_descendants' of the current 'Node'.
 296 mapByDepthFirst :: Ord k => (TreeMap k y -> Strict.Maybe x -> y) -> TreeMap k x -> TreeMap k y
 297 mapByDepthFirst f =
 298         TreeMap .
 299         Map.map
 300          (\Node{node_value, node_descendants} ->
 301                 let m = mapByDepthFirst f node_descendants in
 302                 node (Strict.Just $ f m node_value) m) .
 303         nodes
 304
 305 -- * Alter
 306
 307 alterl_path :: Ord k => (Strict.Maybe x -> Strict.Maybe x) -> Path k -> TreeMap k x -> TreeMap k x
 308 alterl_path fct =
 309         go fct . toNullable
 310         where
 311                 go :: Ord k
 312                  => (Strict.Maybe x -> Strict.Maybe x) -> [k]
 313                  -> TreeMap k x -> TreeMap k x
 314                 go _f [] m = m
 315                 go f (k:p) (TreeMap m) =
 316                         TreeMap $
 317                         Map.alter
 318                          (\c ->
 319                                 let (cv, cm) =
 320                                         case c of
 321                                          Just Node{node_value=v, node_descendants=d} -> (v, d)
 322                                          Nothing -> (Strict.Nothing, empty) in
 323                                 let fx = f cv in
 324                                 let gm = go f p cm in
 325                                 case (fx, size gm) of
 326                                  (Strict.Nothing, 0) -> Nothing
 327                                  (_, s) -> Just
 328                                         Node
 329                                          { node_value = fx
 330                                          , node_descendants = gm
 331                                          , node_size = s + 1
 332                                          }
 333                          ) k m
 334
 335 -- * Fold
 336
 337 -- | Return the given accumulator folded by the given function
 338 -- applied on non-'Strict.Nothing' 'node_value's
 339 -- from left to right through the given 'TreeMap'.
 340 foldlWithPath :: Ord k => (a -> Path k -> x -> a) -> a -> TreeMap k x -> a
 341 foldlWithPath =
 342         foldp []
 343         where
 344                 foldp :: Ord k
 345                  => [k] -> (a -> Path k -> x -> a)
 346                  -> a -> TreeMap k x -> a
 347                 foldp p fct a (TreeMap m) =
 348                         Map.foldlWithKey
 349                          (\acc k Node{..} ->
 350                                 let acc' = Strict.maybe acc (fct acc (reverse $ path k p)) node_value in
 351                                 foldp (k:p) fct acc' node_descendants) a m
 352
 353 -- | Return the given accumulator folded by the given function
 354 -- applied on non-'Strict.Nothing' 'Node's and 'node_value's
 355 -- from left to right through the given 'TreeMap'.
 356 foldlWithPathAndNode :: Ord k => (a -> Node k x -> Path k -> x -> a) -> a -> TreeMap k x -> a
 357 foldlWithPathAndNode =
 358         foldp []
 359         where
 360                 foldp :: Ord k
 361                  => [k] -> (a -> Node k x -> Path k -> x -> a)
 362                  -> a -> TreeMap k x -> a
 363                 foldp p fct a (TreeMap m) =
 364                         Map.foldlWithKey
 365                          (\acc k n@Node{..} ->
 366                                 let acc' = Strict.maybe acc (fct acc n (reverse $ path k p)) node_value in
 367                                 foldp (k:p) fct acc' node_descendants) a m
 368
 369 -- | Return the given accumulator folded by the given function
 370 -- applied on non-'Strict.Nothing' 'node_value's
 371 -- from right to left through the given 'TreeMap'.
 372 foldrWithPath :: Ord k => (Path k -> x -> a -> a) -> a -> TreeMap k x -> a
 373 foldrWithPath =
 374         foldp []
 375         where
 376                 foldp :: Ord k
 377                  => [k] -> (Path k -> x -> a -> a)
 378                  -> a -> TreeMap k x -> a
 379                 foldp p fct a (TreeMap m) =
 380                         Map.foldrWithKey
 381                          (\k Node{..} acc ->
 382                                 let acc' = foldp (k:p) fct acc node_descendants in
 383                                 Strict.maybe acc' (\x -> fct (reverse $ path k p) x acc') node_value) a m
 384
 385 -- | Return the given accumulator folded by the given function
 386 -- applied on non-'Strict.Nothing' 'Node's and 'node_value's
 387 -- from right to left through the given 'TreeMap'.
 388 foldrWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> a -> a) -> a -> TreeMap k x -> a
 389 foldrWithPathAndNode =
 390         foldp []
 391         where
 392                 foldp :: Ord k
 393                  => [k] -> (Node k x -> Path k -> x -> a -> a)
 394                  -> a -> TreeMap k x -> a
 395                 foldp p fct a (TreeMap m) =
 396                         Map.foldrWithKey
 397                          (\k n@Node{..} acc ->
 398                                 let acc' = foldp (k:p) fct acc node_descendants in
 399                                 Strict.maybe acc' (\x -> fct n (reverse $ path k p) x acc') node_value) a m
 400
 401 -- | Return the given accumulator folded by the given function
 402 -- applied on non-'Strict.Nothing' 'node_value's
 403 -- from left to right along the given 'Path'.
 404 foldlPath :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
 405 foldlPath fct =
 406         go fct [] . toNullable
 407         where
 408                 go :: Ord k
 409                  => (Path k -> x -> a -> a) -> [k] -> [k]
 410                  -> TreeMap k x -> a -> a
 411                 go _f _ [] _t a = a
 412                 go f p (k:n) (TreeMap t) a =
 413                         case Map.lookup k t of
 414                          Nothing -> a
 415                          Just Node{..} ->
 416                                 case node_value of
 417                                  Strict.Nothing -> go f (k:p) n node_descendants a
 418                                  Strict.Just x  -> go f (k:p) n node_descendants (f (reverse $ path k p) x a)
 419
 420 -- | Return the given accumulator folded by the given function
 421 -- applied on non-'Strict.Nothing' 'node_value's
 422 -- from right to left along the given 'Path'.
 423 foldrPath :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
 424 foldrPath fct =
 425         go fct [] . toNullable
 426         where
 427                 go :: Ord k
 428                  => (Path k -> x -> a -> a) -> [k] -> [k]
 429                  -> TreeMap k x -> a -> a
 430                 go _f _ [] _t a = a
 431                 go f p (k:n) (TreeMap t) a =
 432                         case Map.lookup k t of
 433                          Nothing -> a
 434                          Just Node{..} ->
 435                                 case node_value of
 436                                  Strict.Nothing -> go f (k:p) n node_descendants a
 437                                  Strict.Just x  -> f (reverse $ path k p) x $ go f (k:p) n node_descendants a
 438
 439 -- * Flatten
 440
 441 -- | Return a 'Map' associating each 'Path'
 442 -- leading to a non-'Strict.Nothing' 'node_value' in the given 'TreeMap',
 443 -- with its value mapped by the given function.
 444 flatten :: Ord k => (x -> y) -> TreeMap k x -> Map (Path k) y
 445 flatten = flattenWithPath . const
 446
 447 -- | Like 'flatten' but with also the current 'Path' given to the mapping function.
 448 flattenWithPath :: Ord k => (Path k -> x -> y) -> TreeMap k x -> Map (Path k) y
 449 flattenWithPath =
 450         flat_map []
 451         where
 452                 flat_map :: Ord k
 453                  => [k] -> (Path k -> x -> y)
 454                  -> TreeMap k x
 455                  -> Map (Path k) y
 456                 flat_map p f (TreeMap m) =
 457                         Map.unions $
 458                         Map.mapKeysMonotonic (reverse . flip path p) (
 459                         Map.mapMaybeWithKey (\k Node{node_value} ->
 460                                 case node_value of
 461                                  Strict.Nothing -> Nothing
 462                                  Strict.Just x  -> Just $ f (reverse $ path k p) x) m
 463                         ) :
 464                         Map.foldrWithKey
 465                          (\k -> (:) . flat_map (k:p) f . node_descendants)
 466                          [] m
 467
 468 -- * Filter
 469
 470 -- | Return the given 'TreeMap'
 471 --   keeping only its non-'Strict.Nothing' 'node_value's
 472 --   passing the given predicate.
 473 filter :: Ord k => (x -> Bool) -> TreeMap k x -> TreeMap k x
 474 filter f =
 475         mapMaybeWithPath
 476          (\_p x -> if f x then Strict.Just x else Strict.Nothing)
 477
 478 -- | Like 'filter' but with also the current 'Path' given to the predicate.
 479 filterWithPath :: Ord k => (Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
 480 filterWithPath f =
 481         mapMaybeWithPath
 482          (\p x -> if f p x then Strict.Just x else Strict.Nothing)
 483
 484 -- | Like 'filterWithPath' but with also the current 'Node' given to the predicate.
 485 filterWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
 486 filterWithPathAndNode f =
 487         mapMaybeWithPathAndNode
 488          (\n p x -> if f n p x then Strict.Just x else Strict.Nothing)
 489
 490 -- | Return the given 'TreeMap'
 491 --   mapping its non-'Strict.Nothing' 'node_value's
 492 --   and keeping only the non-'Strict.Nothing' results.
 493 mapMaybe :: Ord k => (x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y
 494 mapMaybe = mapMaybeWithPath . const
 495
 496 -- | Like 'mapMaybe' but with also the current 'Path' given to the predicate.
 497 mapMaybeWithPath :: Ord k => (Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y
 498 mapMaybeWithPath = mapMaybeWithPathAndNode . const
 499
 500 -- | Like 'mapMaybeWithPath' but with also the current 'Node' given to the predicate.
 501 mapMaybeWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y
 502 mapMaybeWithPathAndNode =
 503         go []
 504         where
 505                 go :: Ord k
 506                  => [k] -> (Node k x -> Path k -> x -> Strict.Maybe y)
 507                  -> TreeMap k x
 508                  -> TreeMap k y
 509                 go p test (TreeMap m) =
 510                         TreeMap $
 511                         Map.mapMaybeWithKey
 512                          (\k nod@Node{node_value=v, node_descendants=ns} ->
 513                                 let node_descendants = go (k:p) test ns in
 514                                 let node_size = size node_descendants in
 515                                 case v of
 516                                  Strict.Just x ->
 517                                         let node_value = test nod (reverse $ path k p) x in
 518                                         case node_value of
 519                                          Strict.Nothing | null node_descendants -> Nothing
 520                                          Strict.Nothing -> Just Node{node_value, node_descendants, node_size=1 + node_size}
 521                                          Strict.Just _  -> Just Node{node_value, node_descendants, node_size}
 522                                  _ ->
 523                                         if null node_descendants
 524                                         then Nothing
 525                                         else Just Node{node_value=Strict.Nothing, node_descendants, node_size}
 526                          ) m