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