packages feed

treemap 1.20160814 → 2.0.0.20161218

raw patch · 5 files changed

+173/−171 lines, 5 filesdep ~transformers

Dependency ranges changed: transformers

Files

Data/TreeMap/Strict.hs view
@@ -1,6 +1,7 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE RecordWildCards #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  -- | This module implements a strict 'TreeMap',@@ -12,6 +13,7 @@  import           Control.Applicative (Applicative(..)) import           Control.DeepSeq (NFData(..))+import           Control.Monad (Monad(..)) import           Data.Bool import           Data.Data (Data) import           Data.Eq (Eq)@@ -22,7 +24,7 @@ import qualified Data.List.NonEmpty import           Data.List.NonEmpty (NonEmpty(..)) import           Data.Map.Strict (Map)-import qualified Data.Map.Strict as Data.Map+import qualified Data.Map.Strict as Map import           Data.Maybe (Maybe(..), maybe) import           Data.Monoid (Monoid(..)) import           Data.Ord (Ord(..))@@ -66,7 +68,7 @@ -- * Type 'Path'  -- | A 'Path' is a non-empty list of 'Map' keys.-type Path k = NonEmpty k+type Path = NonEmpty  path :: k -> [k] -> Path k path = (:|)@@ -85,25 +87,12 @@  ,   node_descendants :: !(TreeMap k x) -- ^ Descendants 'Node's.  } deriving (Data, Eq, Show, Typeable) - instance (Ord k, Monoid v) => Monoid (Node k v) where-	mempty =-		Node-		 { node_value       = Strict.Nothing-		 , node_size        = 0-		 , node_descendants = TreeMap mempty-		 }+	mempty = node Strict.Nothing (TreeMap mempty) 	mappend 	 Node{node_value=x0, node_descendants=m0} 	 Node{node_value=x1, node_descendants=m1} =-		let node_descendants = union const m0 m1 in-		let node_value = x0 `mappend` x1 in-		Node-		 { node_value-		 , node_size = size node_descendants-		               + Strict.maybe 0 (const 1) node_value-		 , node_descendants-		 }+		node (x0 `mappend` x1) (union const m0 m1) 	-- mconcat = Data.List.foldr mappend mempty instance Ord k => Functor (Node k) where 	fmap f Node{node_value=x, node_descendants=m, node_size} =@@ -125,30 +114,38 @@ instance (Ord k, NFData k, NFData x) => NFData (Node k x) where 	rnf (Node s v d) = rnf s `seq` rnf v `seq` rnf d +node :: Strict.Maybe x -> TreeMap k x -> Node k x+node node_value node_descendants =+	Node+	 { node_value+	 , node_size =+		size node_descendants ++		Strict.maybe 0 (const 1) node_value+	 , node_descendants+	 }++node_empty :: Node k x+node_empty = node Strict.Nothing empty+ node_find :: Ord k => [k] -> Node k x -> Strict.Maybe (Node k x) node_find [] n = Strict.Just n node_find (k:ks) Node{node_descendants=TreeMap m} = 	maybe Strict.Nothing (node_find ks) $-	Data.Map.lookup k m+	Map.lookup k m  -- * Construct  -- | Return the empty 'TreeMap'.-empty :: Ord k => TreeMap k x-empty = TreeMap Data.Map.empty+empty :: TreeMap k x+empty = TreeMap Map.empty  -- | Return a 'TreeMap' only mapping the given 'Path' to the given value. singleton :: Ord k => Path k -> x -> TreeMap k x singleton ks x = insert const ks x empty  -- | Return a 'Node' only containing the given value.-leaf :: Ord k => x -> Node k x-leaf x =-	Node-	 { node_value = Strict.Just x-	 , node_descendants = empty-	 , node_size = 1-	 }+leaf :: x -> Node k x+leaf x = node (Strict.Just x) empty  -- | Return the given 'TreeMap' associating the given 'Path' with the given value, -- merging values if the given 'TreeMap' already associates the given 'Path'@@ -156,27 +153,16 @@ insert :: Ord k => (x -> x -> x) -> Path k -> x -> TreeMap k x -> TreeMap k x insert merge (k:|[]) x (TreeMap m) = 	TreeMap $-	Data.Map.insertWith-	 (\_ Node{node_value = x1, node_descendants = m1, node_size = s1} ->-		Node-		 { node_value = Strict.maybe (Strict.Just x) (Strict.Just . merge x) x1-		 , node_descendants = m1-		 , node_size = Strict.maybe (s1 + 1) (const s1) x1-		 })+	Map.insertWith (\_ Node{..} -> node+		 (Strict.maybe (Strict.Just x) (Strict.Just . merge x) node_value)+		 node_descendants) 	 k (leaf x) m insert merge (k:|k':ks) x (TreeMap m) = 	TreeMap $-	Data.Map.insertWith-	 (\_ Node{node_value = x1, node_descendants = m1} ->-		let m' = insert merge (path k' ks) x m1 in-		let s' = size m' + Strict.maybe 0 (const 1) x1 in-		Node{node_value=x1, node_descendants=m', node_size=s'})+	Map.insertWith (\_ Node{..} -> node node_value $+		insert merge (path k' ks) x node_descendants) 	 k-	 Node-		 { node_value = Strict.Nothing-		 , node_descendants = insert merge (path k' ks) x empty-		 , node_size = 1-		 }+	 (node Strict.Nothing (insert merge (path k' ks) x empty)) 	 m  -- | Return a 'TreeMap' associating for each tuple of the given list@@ -189,32 +175,32 @@ -- the 'Path' to the value, -- merging values of identical 'Path's (in respective order). from_Map :: Ord k => (x -> x -> x) -> Map (Path k) x -> TreeMap k x-from_Map merge = Data.Map.foldlWithKey (\acc p x -> insert merge p x acc) empty+from_Map merge = Map.foldlWithKey (\acc p x -> insert merge p x acc) empty  -- * Size  -- | Return the 'Map' in the given 'TreeMap'.-nodes :: Ord k => TreeMap k x -> Map k (Node k x)+nodes :: TreeMap k x -> Map k (Node k x) nodes (TreeMap m) = m  -- | Return 'True' iif. the given 'TreeMap' is 'empty'.-null :: Ord k => TreeMap k x -> Bool-null (TreeMap m) = Data.Map.null m+null :: TreeMap k x -> Bool+null (TreeMap m) = Map.null m  -- | Return the number of non-'Strict.Nothing' 'node_value's in the given 'TreeMap'. -- --   * Complexity: O(r) where r is the size of the root 'Map'.-size :: Ord k => TreeMap k x -> Int-size = Data.Map.foldr ((+) . node_size) 0 . nodes+size :: TreeMap k x -> Int+size = Map.foldr ((+) . node_size) 0 . nodes  -- * Find  -- | Return the value (if any) associated with the given 'Path'. find :: Ord k => Path k -> TreeMap k x -> Strict.Maybe x-find (k:|[]) (TreeMap m) = maybe Strict.Nothing node_value $ Data.Map.lookup k m+find (k:|[]) (TreeMap m) = maybe Strict.Nothing node_value $ Map.lookup k m find (k:|k':ks) (TreeMap m) = 	maybe Strict.Nothing (find (path k' ks) . node_descendants) $-	Data.Map.lookup k m+	Map.lookup k m  -- | Return the values (if any) associated with the prefixes of the given 'Path' (included). find_along :: Ord k => Path k -> TreeMap k x -> [x]@@ -224,17 +210,18 @@ 		go :: Ord k => [k] -> Map k (Node k x) -> [x] 		go [] _m = [] 		go (k:ks) m =-			case Data.Map.lookup k m of+			case Map.lookup k m of 			 Nothing -> []-			 Just node ->-				Strict.maybe id (:) (node_value node) $-				go ks $ nodes (node_descendants node)+			 Just nod ->+				Strict.maybe id (:) (node_value nod) $+				go ks $ nodes (node_descendants nod) -find_node :: Ord k => Path k -> TreeMap k x -> Strict.Maybe (Node k x)-find_node (k:|[]) (TreeMap m) = maybe Strict.Nothing Strict.Just $ Data.Map.lookup k m+-- | Return the 'Node' (if any) associated with the given 'Path'.+find_node :: Ord k => Path k -> TreeMap k x -> Maybe (Node k x)+find_node (k:|[]) (TreeMap m) = Map.lookup k m find_node (k:|k':ks) (TreeMap m) =-	maybe Strict.Nothing (find_node (path k' ks) . node_descendants) $-	Data.Map.lookup k m+	Map.lookup k m >>=+	find_node (path k' ks) . node_descendants  -- * Union @@ -244,16 +231,11 @@ union :: Ord k => (x -> x -> x) -> TreeMap k x -> TreeMap k x -> TreeMap k x union merge (TreeMap tm0) (TreeMap tm1) = 	TreeMap $-	Data.Map.unionWith+	Map.unionWith 	 (\Node{node_value=x0, node_descendants=m0} 	   Node{node_value=x1, node_descendants=m1} ->-		let node_descendants = union merge m0 m1 in-		let node_value = Strict.maybe x1 (\x0' -> Strict.maybe (Strict.Just x0') (Strict.Just . merge x0') x1) x0 in-		Node-		 { node_size = size node_descendants + Strict.maybe 0 (const 1) node_value-		 , node_value-		 , node_descendants-		 })+		node (Strict.maybe x1 (\x0' -> Strict.maybe (Strict.Just x0') (Strict.Just . merge x0') x1) x0)+		 (union merge m0 m1)) 	 tm0 tm1  -- | Return the 'union' of the given 'TreeMap's.@@ -275,7 +257,7 @@ map :: Ord k => (x -> y) -> TreeMap k x -> TreeMap k y map f = 	TreeMap .-	Data.Map.map+	Map.map 	 (\n@Node{node_value=x, node_descendants=m} -> 		n{ node_value       = fmap f x 		 , node_descendants = map f m@@ -287,12 +269,12 @@ -- mapped by the given functions. -- -- WARNING: the function mapping 'Path' sections must be monotonic,--- like in 'Data.Map.mapKeysMonotonic'.+-- like in 'Map.mapKeysMonotonic'. map_monotonic :: (Ord k, Ord l) => (k -> l) -> (x -> y) -> TreeMap k x -> TreeMap l y map_monotonic fk fx = 	TreeMap .-	Data.Map.mapKeysMonotonic fk .-	Data.Map.map+	Map.mapKeysMonotonic fk .+	Map.map 	 (\n@Node{node_value=x, node_descendants=m} -> 		n{ node_value       = fmap fx x 		 , node_descendants = map_monotonic fk fx m@@ -305,14 +287,10 @@ map_by_depth_first :: Ord k => (TreeMap k y -> Strict.Maybe x -> y) -> TreeMap k x -> TreeMap k y map_by_depth_first f = 	TreeMap .-	Data.Map.map+	Map.map 	 (\Node{node_value, node_descendants} -> 		let m = map_by_depth_first f node_descendants in-		Node-		 { node_value = Strict.Just $ f m node_value-		 , node_descendants = m-		 , node_size = size m + 1-		 }) .+		node (Strict.Just $ f m node_value) m) . 	nodes  -- * Alter@@ -327,7 +305,7 @@ 		go _f [] m = m 		go f (k:p) (TreeMap m) = 			TreeMap $-			Data.Map.alter+			Map.alter 			 (\c -> 				let (cv, cm) = 					case c of@@ -358,8 +336,8 @@ 		 => [k] -> (a -> Path k -> x -> a) 		 -> a -> TreeMap k x -> a 		foldp p fct a (TreeMap m) =-			Data.Map.foldlWithKey-			 (\acc k Node{node_value, node_descendants} ->+			Map.foldlWithKey+			 (\acc k Node{..} -> 				let acc' = Strict.maybe acc (fct acc (reverse $ path k p)) node_value in 				foldp (k:p) fct acc' node_descendants) a m @@ -374,8 +352,8 @@ 		 => [k] -> (a -> Node k x -> Path k -> x -> a) 		 -> a -> TreeMap k x -> a 		foldp p fct a (TreeMap m) =-			Data.Map.foldlWithKey-			 (\acc k n@Node{node_value, node_descendants} ->+			Map.foldlWithKey+			 (\acc k n@Node{..} -> 				let acc' = Strict.maybe acc (fct acc n (reverse $ path k p)) node_value in 				foldp (k:p) fct acc' node_descendants) a m @@ -390,8 +368,8 @@ 		 => [k] -> (Path k -> x -> a -> a) 		 -> a -> TreeMap k x -> a 		foldp p fct a (TreeMap m) =-			Data.Map.foldrWithKey-			 (\k Node{node_value, node_descendants} acc ->+			Map.foldrWithKey+			 (\k Node{..} acc -> 				let acc' = foldp (k:p) fct acc node_descendants in 				Strict.maybe acc' (\x -> fct (reverse $ path k p) x acc') node_value) a m @@ -406,8 +384,8 @@ 		 => [k] -> (Node k x -> Path k -> x -> a -> a) 		 -> a -> TreeMap k x -> a 		foldp p fct a (TreeMap m) =-			Data.Map.foldrWithKey-			 (\k n@Node{node_value, node_descendants} acc ->+			Map.foldrWithKey+			 (\k n@Node{..} acc -> 				let acc' = foldp (k:p) fct acc node_descendants in 				Strict.maybe acc' (\x -> fct n (reverse $ path k p) x acc') node_value) a m @@ -423,12 +401,12 @@ 		 -> TreeMap k x -> a -> a 		go _f _ [] _t a = a 		go f p (k:n) (TreeMap t) a =-			case Data.Map.lookup k t of+			case Map.lookup k t of 			 Nothing -> a-			 Just Node{node_value=v, node_descendants=d} ->-				case v of-				 Strict.Nothing -> go f (k:p) n d a-				 Strict.Just x  -> go f (k:p) n d (f (reverse $ path k p) x a)+			 Just Node{..} ->+				case node_value of+				 Strict.Nothing -> go f (k:p) n node_descendants a+				 Strict.Just x  -> go f (k:p) n node_descendants (f (reverse $ path k p) x a)  -- | Return the given accumulator folded by the given function -- applied on non-'Strict.Nothing' 'node_value's@@ -442,12 +420,12 @@ 		 -> TreeMap k x -> a -> a 		go _f _ [] _t a = a 		go f p (k:n) (TreeMap t) a =-			case Data.Map.lookup k t of+			case Map.lookup k t of 			 Nothing -> a-			 Just Node{node_value=v, node_descendants=d} ->-				case v of-				 Strict.Nothing -> go f (k:p) n d a-				 Strict.Just x  -> f (reverse $ path k p) x $ go f (k:p) n d a+			 Just Node{..} ->+				case node_value of+				 Strict.Nothing -> go f (k:p) n node_descendants a+				 Strict.Just x  -> f (reverse $ path k p) x $ go f (k:p) n node_descendants a  -- * Flatten @@ -467,14 +445,14 @@ 		 -> TreeMap k x 		 -> Map (Path k) y 		flat_map p f (TreeMap m) =-			Data.Map.unions $-			Data.Map.mapKeysMonotonic (reverse . flip path p) (-			Data.Map.mapMaybeWithKey (\k Node{node_value} ->+			Map.unions $+			Map.mapKeysMonotonic (reverse . flip path p) (+			Map.mapMaybeWithKey (\k Node{node_value} -> 				case node_value of 				 Strict.Nothing -> Nothing 				 Strict.Just x  -> Just $ f (reverse $ path k p) x) m 			) :-			Data.Map.foldrWithKey+			Map.foldrWithKey 			 (\k -> (:) . flat_map (k:p) f . node_descendants) 			 [] m @@ -521,13 +499,13 @@ 		 -> TreeMap k y 		go p test (TreeMap m) = 			TreeMap $-			Data.Map.mapMaybeWithKey-			 (\k node@Node{node_value=v, node_descendants=ns} ->+			Map.mapMaybeWithKey+			 (\k nod@Node{node_value=v, node_descendants=ns} -> 				let node_descendants = go (k:p) test ns in 				let node_size = size node_descendants in 				case v of 				 Strict.Just x ->-					let node_value = test node (reverse $ path k p) x in+					let node_value = test nod (reverse $ path k p) x in 					case node_value of 					 Strict.Nothing | null node_descendants -> Nothing 					 Strict.Nothing -> Just Node{node_value, node_descendants, node_size=1 + node_size}
Data/TreeMap/Strict/Test.hs view
@@ -21,11 +21,7 @@  [ testGroup "insert" 	 [ testCase "[] 0" $ 			TreeMap.insert const ((0::Int):|[]) () TreeMap.empty-		 @?=-			(TreeMap.TreeMap $-			Map.fromList-			 [ (0::Int, TreeMap.leaf ())-			 ])+		 @?= (TreeMap.TreeMap $ Map.fromList [ (0::Int, TreeMap.leaf ()) ]) 	 , testCase "[] 0/1" $ 			TreeMap.insert const ((0::Int):|[1]) () TreeMap.empty 		 @?=
Data/TreeMap/Strict/Zipper.hs view
@@ -5,14 +5,19 @@ module Data.TreeMap.Strict.Zipper where  import           Control.Monad (Monad(..), (>=>))+import           Control.Applicative (Applicative(..), Alternative(..))+import           Data.Bool (Bool) import           Data.Data (Data) import           Data.Eq (Eq) import           Data.Function (($), (.))+import           Data.Functor ((<$>))+import           Data.Int (Int) import qualified Data.List as List import           Data.List.NonEmpty (NonEmpty(..)) import qualified Data.Map.Strict as Map import           Data.Maybe (Maybe(..), maybe, maybeToList) import           Data.Ord (Ord(..))+import           Data.Tuple (fst) import           Data.Typeable (Typeable) import           Text.Show (Show(..)) @@ -21,27 +26,30 @@  -- * Type 'Zipper' -data Zipper k x+data Zipper k a  =   Zipper- {   zipper_path :: [Zipper_Step k x]- ,   zipper_curr :: TreeMap k x+ {   zipper_path :: [Zipper_Step k a]+ ,   zipper_curr :: TreeMap k a  } deriving (Data, Eq, Show, Typeable) -zipper :: TreeMap k x -> Zipper k x+zipper :: TreeMap k a -> Zipper k a zipper = Zipper [] -zipper_root :: Ord k => Zipper k x -> TreeMap k x-zipper_root =-	zipper_curr . List.last .-	zipper_collect zipper_parent+zipper_root :: Ord k => Zipper k a -> TreeMap k a+zipper_root = zipper_curr . List.last . zipper_ancestor_or_self +path_of_zipper :: Zipper k x -> [k]+path_of_zipper z =+	fst . zipper_step_self <$>+	List.reverse (zipper_path z)+ -- * Type 'Zipper_Step' -data Zipper_Step k x+data Zipper_Step k a  =   Zipper_Step- {   zipper_step_prec :: TreeMap k x- ,   zipper_step_self :: (k, TreeMap.Node k x)- ,   zipper_step_foll :: TreeMap k x+ {   zipper_step_prec :: TreeMap k a+ ,   zipper_step_self :: (k, TreeMap.Node k a)+ ,   zipper_step_foll :: TreeMap k a  } deriving (Data, Eq, Show, Typeable)  -- * Axis@@ -58,62 +66,64 @@  -- ** Axis self -zipper_self :: Ord k => Zipper k x -> Maybe (k, TreeMap.Node k x)+zipper_self :: Zipper k a -> TreeMap.Node k a zipper_self z = 	case z of 	 Zipper{ zipper_path=-	         Zipper_Step{zipper_step_self}-	         : _ } -> Just zipper_step_self-	 _ -> Nothing+	         Zipper_Step{zipper_step_self=(_, nod)}+	         : _ } -> nod+	 _ -> TreeMap.node_empty  -- ** Axis child -zipper_child :: Ord k => Zipper k x -> [Zipper k x]+zipper_child :: Ord k => Zipper k a -> [Zipper k a] zipper_child z = 	maybeToList (zipper_child_first z) 	>>= zipper_collect zipper_foll -zipper_child_at :: Ord k => k -> Zipper k x -> Maybe (Zipper k x)-zipper_child_at k (Zipper path (TreeMap m)) =+zipper_child_lookup+ :: (Ord k, Alternative f)+ => k -> Zipper k a -> f (Zipper k a)+zipper_child_lookup k (Zipper path (TreeMap m)) = 	case Map.splitLookup k m of-	 (_, Nothing, _) -> Nothing+	 (_, Nothing, _) -> empty 	 (ps, Just s, fs) ->-		Just Zipper+		pure Zipper 		 { zipper_path = Zipper_Step (TreeMap ps) (k, s) (TreeMap fs) : path 		 , zipper_curr = TreeMap.node_descendants s 		 } -zipper_child_first :: Ord k => Zipper k x -> Maybe (Zipper k x)+zipper_child_first :: Alternative f => Zipper k a -> f (Zipper k a) zipper_child_first (Zipper path (TreeMap m)) = 	case Map.minViewWithKey m of-	 Nothing -> Nothing+	 Nothing -> empty 	 Just ((k', s'), fs') ->-		Just Zipper+		pure Zipper 		 { zipper_path = Zipper_Step TreeMap.empty (k', s') (TreeMap fs') : path 		 , zipper_curr = TreeMap.node_descendants s' 		 } -zipper_child_last :: Ord k => Zipper k x -> Maybe (Zipper k x)+zipper_child_last :: Alternative f => Zipper k a -> f (Zipper k a) zipper_child_last (Zipper path (TreeMap m)) = 	case Map.maxViewWithKey m of-	 Nothing -> Nothing+	 Nothing -> empty 	 Just ((k', s'), ps') ->-		Just Zipper+		pure Zipper 		 { zipper_path = Zipper_Step (TreeMap ps') (k', s') TreeMap.empty : path 		 , zipper_curr = TreeMap.node_descendants s' 		 }  -- ** Axis ancestor -zipper_ancestor :: Ord k => Zipper k x -> [Zipper k x]+zipper_ancestor :: Ord k => Zipper k a -> [Zipper k a] zipper_ancestor = zipper_collect_without_self zipper_parent -zipper_ancestor_or_self :: Ord k => Zipper k x -> [Zipper k x]+zipper_ancestor_or_self :: Ord k => Zipper k a -> [Zipper k a] zipper_ancestor_or_self = zipper_collect zipper_parent  -- ** Axis descendant -zipper_descendant_or_self :: Ord k => Zipper k x -> [Zipper k x]+zipper_descendant_or_self :: Ord k => Zipper k a -> [Zipper k a] zipper_descendant_or_self = 	collect_child [] 	where@@ -128,32 +138,34 @@ 				 (zipper_foll z) 			 ) z -zipper_descendant_or_self_reverse :: Ord k => Zipper k x -> [Zipper k x]+zipper_descendant_or_self_reverse :: Ord k => Zipper k a -> [Zipper k a] zipper_descendant_or_self_reverse z = 	z : List.concatMap 	 zipper_descendant_or_self_reverse 	 (List.reverse $ zipper_child z) -zipper_descendant :: Ord k => Zipper k x -> [Zipper k x]+zipper_descendant :: Ord k => Zipper k a -> [Zipper k a] zipper_descendant = List.tail . zipper_descendant_or_self -zipper_descendant_at :: Ord k => TreeMap.Path k -> Zipper k x -> Maybe (Zipper k x)-zipper_descendant_at (k:|ks) =+zipper_descendant_lookup+ :: (Ord k, Alternative f, Monad f)+ => TreeMap.Path k -> Zipper k a -> f (Zipper k a)+zipper_descendant_lookup (k:|ks) = 	case ks of-	 []     -> zipper_child_at k-	 k':ks' -> zipper_child_at k >=> zipper_descendant_at (k':|ks')+	 []     -> zipper_child_lookup k+	 k':ks' -> zipper_child_lookup k >=> zipper_descendant_lookup (k':|ks')  -- ** Axis preceding -zipper_prec :: Ord k => Zipper k x -> Maybe (Zipper k x)+zipper_prec :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a) zipper_prec (Zipper path _curr) = 	case path of-	 [] -> Nothing+	 [] -> empty 	 Zipper_Step (TreeMap ps) (k, s) (TreeMap fs):steps -> 		case Map.maxViewWithKey ps of-		 Nothing -> Nothing+		 Nothing -> empty 		 Just ((k', s'), ps') ->-			Just Zipper+			pure Zipper 			 { zipper_path = Zipper_Step (TreeMap ps') 			                             (k', s') 			                             (TreeMap $ Map.insert k s fs)@@ -161,26 +173,26 @@ 			 , zipper_curr = TreeMap.node_descendants s' 			 } -zipper_preceding :: Ord k => Zipper k x -> [Zipper k x]+zipper_preceding :: Ord k => Zipper k a -> [Zipper k a] zipper_preceding = 	zipper_ancestor_or_self >=> 	zipper_preceding_sibling >=> 	zipper_descendant_or_self_reverse -zipper_preceding_sibling :: Ord k => Zipper k x -> [Zipper k x]+zipper_preceding_sibling :: Ord k => Zipper k a -> [Zipper k a] zipper_preceding_sibling = zipper_collect_without_self zipper_prec  -- ** Axis following -zipper_foll :: Ord k => Zipper k x -> Maybe (Zipper k x)+zipper_foll :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a) zipper_foll (Zipper path _curr) = 	case path of-	 [] -> Nothing+	 [] -> empty 	 Zipper_Step (TreeMap ps) (k, s) (TreeMap fs):steps -> 		case Map.minViewWithKey fs of-		 Nothing -> Nothing+		 Nothing -> empty 		 Just ((k', s'), fs') ->-			Just Zipper+			pure Zipper 			 { zipper_path = Zipper_Step (TreeMap $ Map.insert k s ps) 			                             (k', s') 			                             (TreeMap fs')@@ -188,28 +200,44 @@ 			 , zipper_curr = TreeMap.node_descendants s' 			 } -zipper_following :: Ord k => Zipper k x -> [Zipper k x]+zipper_following :: Ord k => Zipper k a -> [Zipper k a] zipper_following = 	zipper_ancestor_or_self >=> 	zipper_following_sibling >=> 	zipper_descendant_or_self -zipper_following_sibling :: Ord k => Zipper k x -> [Zipper k x]+zipper_following_sibling :: Ord k => Zipper k a -> [Zipper k a] zipper_following_sibling = zipper_collect_without_self zipper_foll  -- ** Axis parent -zipper_parent :: Ord k => Zipper k x -> Maybe (Zipper k x)+zipper_parent :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a) zipper_parent (Zipper path curr) = 	case path of-	 [] -> Nothing+	 [] -> empty 	 Zipper_Step (TreeMap ps) (k, s) (TreeMap fs):steps ->-		let node = TreeMap.Node-			 { TreeMap.node_value       = TreeMap.node_value s-			 , TreeMap.node_size        = TreeMap.size curr-			 , TreeMap.node_descendants = curr-			 } in-		Just Zipper+		let nod = TreeMap.node (TreeMap.node_value s) curr in+		pure Zipper 		 { zipper_path = steps-		 , zipper_curr = TreeMap $ Map.union ps $ Map.insert k node fs+		 , zipper_curr = TreeMap $ Map.union ps $ Map.insert k nod fs 		 }++-- ** Filter++zipper_filter+ :: (Zipper k a -> [Zipper k a])+ -> (Zipper k a -> Bool)+ -> (Zipper k a -> [Zipper k a])+zipper_filter axis p z = List.filter p (axis z)+infixl 5 `zipper_filter`++zipper_at :: Alternative f+ => (Zipper k a -> [Zipper k a]) -> Int+ -> (Zipper k a -> f (Zipper k a))+zipper_at axis n z = case List.drop n (axis z) of {[] -> empty; a:_ -> pure a}+infixl 5 `zipper_at`++zipper_null+ :: (Zipper k a -> [Zipper k a])+ -> Zipper k a -> Bool+zipper_null axis = List.null . axis
stack.yaml view
@@ -1,4 +1,4 @@-resolver: lts-6.12+resolver: lts-7.18 flags: {} packages: - '.'
treemap.cabal view
@@ -20,8 +20,8 @@ name: treemap stability: experimental synopsis: A tree of Data.Map.-tested-with: GHC==7.10.3-version: 1.20160814+tested-with: GHC==8.0.1+version: 2.0.0.20161218  source-repository head   location: git://git.autogeree.net/haskell/treemap@@ -68,7 +68,7 @@     , deepseq     , semigroups     , strict-    , transformers >= 0.4 && < 0.5+    , transformers >= 0.4 && < 0.6  Test-Suite treemap-test   type: exitcode-stdio-1.0@@ -96,5 +96,5 @@     , tasty >= 0.11     , tasty-hunit     , text-    , transformers >= 0.4 && < 0.5+    , transformers >= 0.4 && < 0.6     , treemap