packages feed

treemap 2.0.0.20161218 → 2.4.0.20180213

raw patch · 9 files changed

+527/−512 lines, 9 filesdep +mono-traversabledep ~containersdep ~deepseqdep ~semigroupsPVP ok

version bump matches the API change (PVP)

Dependencies added: mono-traversable

Dependency ranges changed: containers, deepseq, semigroups, strict, tasty-hunit, text, transformers

API changes (from Hackage documentation)

- Data.TreeMap.Strict: filter_with_Path :: Ord k => (Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
- Data.TreeMap.Strict: filter_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
- Data.TreeMap.Strict: find :: Ord k => Path k -> TreeMap k x -> Maybe x
- Data.TreeMap.Strict: find_along :: Ord k => Path k -> TreeMap k x -> [x]
- Data.TreeMap.Strict: find_node :: Ord k => Path k -> TreeMap k x -> Maybe (Node k x)
- Data.TreeMap.Strict: flatten_with_Path :: Ord k => (Path k -> x -> y) -> TreeMap k x -> Map (Path k) y
- Data.TreeMap.Strict: foldl_path :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
- Data.TreeMap.Strict: foldl_with_Path :: Ord k => (a -> Path k -> x -> a) -> a -> TreeMap k x -> a
- Data.TreeMap.Strict: foldl_with_Path_and_Node :: Ord k => (a -> Node k x -> Path k -> x -> a) -> a -> TreeMap k x -> a
- Data.TreeMap.Strict: foldr_path :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
- Data.TreeMap.Strict: foldr_with_Path :: Ord k => (Path k -> x -> a -> a) -> a -> TreeMap k x -> a
- Data.TreeMap.Strict: foldr_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> a -> a) -> a -> TreeMap k x -> a
- Data.TreeMap.Strict: from_List :: Ord k => (x -> x -> x) -> [(Path k, x)] -> TreeMap k x
- Data.TreeMap.Strict: from_Map :: Ord k => (x -> x -> x) -> Map (Path k) x -> TreeMap k x
- Data.TreeMap.Strict: instance (GHC.Classes.Ord k, GHC.Base.Monoid v) => GHC.Base.Monoid (Data.TreeMap.Strict.Node k v)
- Data.TreeMap.Strict: instance GHC.Base.Monoid x => GHC.Base.Monoid (Data.Strict.Maybe.Maybe x)
- Data.TreeMap.Strict: list :: Path k -> [k]
- Data.TreeMap.Strict: map_Maybe :: Ord k => (x -> Maybe y) -> TreeMap k x -> TreeMap k y
- Data.TreeMap.Strict: map_Maybe_with_Path :: Ord k => (Path k -> x -> Maybe y) -> TreeMap k x -> TreeMap k y
- Data.TreeMap.Strict: map_Maybe_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> Maybe y) -> TreeMap k x -> TreeMap k y
- Data.TreeMap.Strict: map_by_depth_first :: Ord k => (TreeMap k y -> Maybe x -> y) -> TreeMap k x -> TreeMap k y
- Data.TreeMap.Strict: map_monotonic :: (Ord k, Ord l) => (k -> l) -> (x -> y) -> TreeMap k x -> TreeMap l y
- Data.TreeMap.Strict: node_empty :: Node k x
- Data.TreeMap.Strict: node_find :: Ord k => [k] -> Node k x -> Maybe (Node k x)
- Data.TreeMap.Strict: reverse :: Path k -> Path k
- Data.TreeMap.Strict.Zipper: Zipper_Step :: TreeMap k a -> (k, Node k a) -> TreeMap k a -> Zipper_Step k a
- Data.TreeMap.Strict.Zipper: [zipper_step_foll] :: Zipper_Step k a -> TreeMap k a
- Data.TreeMap.Strict.Zipper: [zipper_step_prec] :: Zipper_Step k a -> TreeMap k a
- Data.TreeMap.Strict.Zipper: [zipper_step_self] :: Zipper_Step k a -> (k, Node k a)
- Data.TreeMap.Strict.Zipper: data Zipper_Step k a
- Data.TreeMap.Strict.Zipper: instance (GHC.Classes.Eq k, GHC.Classes.Eq a) => GHC.Classes.Eq (Data.TreeMap.Strict.Zipper.Zipper_Step k a)
- Data.TreeMap.Strict.Zipper: instance (GHC.Classes.Ord k, Data.Data.Data a, Data.Data.Data k) => Data.Data.Data (Data.TreeMap.Strict.Zipper.Zipper_Step k a)
- Data.TreeMap.Strict.Zipper: instance (GHC.Show.Show k, GHC.Show.Show a) => GHC.Show.Show (Data.TreeMap.Strict.Zipper.Zipper_Step k a)
- Data.TreeMap.Strict.Zipper: path_of_zipper :: Zipper k x -> [k]
- Data.TreeMap.Strict.Zipper: zipper_ancestor :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_ancestor_or_self :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_at :: Alternative f => (Zipper k a -> [Zipper k a]) -> Int -> (Zipper k a -> f (Zipper k a))
- Data.TreeMap.Strict.Zipper: zipper_child :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_child_first :: Alternative f => Zipper k a -> f (Zipper k a)
- Data.TreeMap.Strict.Zipper: zipper_child_last :: Alternative f => Zipper k a -> f (Zipper k a)
- Data.TreeMap.Strict.Zipper: zipper_child_lookup :: (Ord k, Alternative f) => k -> Zipper k a -> f (Zipper k a)
- Data.TreeMap.Strict.Zipper: zipper_collect :: (z -> Maybe z) -> z -> [z]
- Data.TreeMap.Strict.Zipper: zipper_collect_without_self :: (z -> Maybe z) -> z -> [z]
- Data.TreeMap.Strict.Zipper: zipper_descendant :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_descendant_lookup :: (Ord k, Alternative f, Monad f) => Path k -> Zipper k a -> f (Zipper k a)
- Data.TreeMap.Strict.Zipper: zipper_descendant_or_self :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_descendant_or_self_reverse :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_filter :: (Zipper k a -> [Zipper k a]) -> (Zipper k a -> Bool) -> (Zipper k a -> [Zipper k a])
- Data.TreeMap.Strict.Zipper: zipper_foll :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a)
- Data.TreeMap.Strict.Zipper: zipper_following :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_following_sibling :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_parent :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a)
- Data.TreeMap.Strict.Zipper: zipper_prec :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a)
- Data.TreeMap.Strict.Zipper: zipper_preceding :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_preceding_sibling :: Ord k => Zipper k a -> [Zipper k a]
- Data.TreeMap.Strict.Zipper: zipper_root :: Ord k => Zipper k a -> TreeMap k a
- Data.TreeMap.Strict.Zipper: zipper_self :: Zipper k a -> Node k a
+ Data.TreeMap.Strict: (<|) :: k -> [k] -> Path k
+ Data.TreeMap.Strict: (\\) :: Ord k => TreeMap k x -> TreeMap k y -> TreeMap k x
+ Data.TreeMap.Strict: filterWithPath :: Ord k => (Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
+ Data.TreeMap.Strict: filterWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x
+ Data.TreeMap.Strict: flattenWithPath :: Ord k => (Path k -> x -> y) -> TreeMap k x -> Map (Path k) y
+ Data.TreeMap.Strict: foldlPath :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
+ Data.TreeMap.Strict: foldlWithPath :: Ord k => (a -> Path k -> x -> a) -> a -> TreeMap k x -> a
+ Data.TreeMap.Strict: foldlWithPathAndNode :: Ord k => (a -> Node k x -> Path k -> x -> a) -> a -> TreeMap k x -> a
+ Data.TreeMap.Strict: foldrPath :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a
+ Data.TreeMap.Strict: foldrWithPath :: Ord k => (Path k -> x -> a -> a) -> a -> TreeMap k x -> a
+ Data.TreeMap.Strict: foldrWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> a -> a) -> a -> TreeMap k x -> a
+ Data.TreeMap.Strict: fromList :: Ord k => (x -> x -> x) -> [(Path k, x)] -> TreeMap k x
+ Data.TreeMap.Strict: fromMap :: Ord k => Map (Path k) x -> TreeMap k x
+ Data.TreeMap.Strict: instance (GHC.Classes.Ord k, Data.Semigroup.Semigroup v) => Data.Semigroup.Semigroup (Data.TreeMap.Strict.Node k v)
+ Data.TreeMap.Strict: instance (GHC.Classes.Ord k, Data.Semigroup.Semigroup v) => Data.Semigroup.Semigroup (Data.TreeMap.Strict.TreeMap k v)
+ Data.TreeMap.Strict: instance (GHC.Classes.Ord k, Data.Semigroup.Semigroup v) => GHC.Base.Monoid (Data.TreeMap.Strict.Node k v)
+ Data.TreeMap.Strict: instance (GHC.Classes.Ord k, GHC.Classes.Ord x) => GHC.Classes.Ord (Data.TreeMap.Strict.Node k x)
+ Data.TreeMap.Strict: instance (GHC.Classes.Ord x, GHC.Classes.Ord k) => GHC.Classes.Ord (Data.TreeMap.Strict.TreeMap k x)
+ Data.TreeMap.Strict: instance Data.Semigroup.Semigroup x => Data.Semigroup.Semigroup (Data.Strict.Maybe.Maybe x)
+ Data.TreeMap.Strict: instance Data.Semigroup.Semigroup x => GHC.Base.Monoid (Data.Strict.Maybe.Maybe x)
+ Data.TreeMap.Strict: instance GHC.Base.Alternative Data.Strict.Maybe.Maybe
+ Data.TreeMap.Strict: instance GHC.Base.Applicative Data.Strict.Maybe.Maybe
+ Data.TreeMap.Strict: intersection :: Ord k => (Maybe x -> Maybe y -> Maybe z) -> TreeMap k x -> TreeMap k y -> TreeMap k z
+ Data.TreeMap.Strict: lookup :: Ord k => Path k -> TreeMap k x -> Maybe x
+ Data.TreeMap.Strict: lookupAlong :: Ord k => Path k -> TreeMap k x -> [x]
+ Data.TreeMap.Strict: lookupNode :: Ord k => Path k -> TreeMap k x -> Maybe (Node k x)
+ Data.TreeMap.Strict: mapByDepthFirst :: Ord k => (TreeMap k y -> Maybe x -> y) -> TreeMap k x -> TreeMap k y
+ Data.TreeMap.Strict: mapMaybe :: Ord k => (x -> Maybe y) -> TreeMap k x -> TreeMap k y
+ Data.TreeMap.Strict: mapMaybeWithPath :: Ord k => (Path k -> x -> Maybe y) -> TreeMap k x -> TreeMap k y
+ Data.TreeMap.Strict: mapMaybeWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> Maybe y) -> TreeMap k x -> TreeMap k y
+ Data.TreeMap.Strict: mapMonotonic :: (Ord k, Ord l) => (k -> l) -> (x -> y) -> TreeMap k x -> TreeMap l y
+ Data.TreeMap.Strict: nodeEmpty :: Node k x
+ Data.TreeMap.Strict: nodeLookup :: Ord k => [k] -> Node k x -> Maybe (Node k x)
+ Data.TreeMap.Strict.Zipper: Cursor :: TreeMap k a -> (k, Node k a) -> TreeMap k a -> Cursor k a
+ Data.TreeMap.Strict.Zipper: [cursor_followings] :: Cursor k a -> TreeMap k a
+ Data.TreeMap.Strict.Zipper: [cursor_precedings] :: Cursor k a -> TreeMap k a
+ Data.TreeMap.Strict.Zipper: [cursor_self] :: Cursor k a -> (k, Node k a)
+ Data.TreeMap.Strict.Zipper: axis_ancestor :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_ancestor_or_self :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_at :: Alternative f => Axis k a -> Int -> AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_child :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_child_first :: Alternative f => AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_child_last :: Alternative f => AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_child_lookup :: (Ord k, Alternative f) => k -> AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_child_lookups :: (Ord k, Alternative f, Monad f) => Path k -> AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_collect :: (z -> Maybe z) -> z -> [z]
+ Data.TreeMap.Strict.Zipper: axis_collect_without_self :: (z -> Maybe z) -> z -> [z]
+ Data.TreeMap.Strict.Zipper: axis_descendant :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_descendant_or_self :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_descendant_or_self_reverse :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_filter :: Axis k a -> (Zipper k a -> Bool) -> Axis k a
+ Data.TreeMap.Strict.Zipper: axis_following :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_following_sibling :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_following_sibling_nearest :: (Ord k, Alternative f) => AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_parent :: (Ord k, Alternative f) => AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_preceding :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_preceding_sibling :: Ord k => Axis k a
+ Data.TreeMap.Strict.Zipper: axis_preceding_sibling_nearest :: (Ord k, Alternative f) => AxisAlt f k a
+ Data.TreeMap.Strict.Zipper: axis_self :: Zipper k a -> Node k a
+ Data.TreeMap.Strict.Zipper: current :: Zipper k a -> TreeMap k a
+ Data.TreeMap.Strict.Zipper: data Cursor k a
+ Data.TreeMap.Strict.Zipper: instance (GHC.Classes.Eq k, GHC.Classes.Eq a) => GHC.Classes.Eq (Data.TreeMap.Strict.Zipper.Cursor k a)
+ Data.TreeMap.Strict.Zipper: instance (GHC.Classes.Ord k, Data.Data.Data a, Data.Data.Data k) => Data.Data.Data (Data.TreeMap.Strict.Zipper.Cursor k a)
+ Data.TreeMap.Strict.Zipper: instance (GHC.Show.Show k, GHC.Show.Show a) => GHC.Show.Show (Data.TreeMap.Strict.Zipper.Cursor k a)
+ Data.TreeMap.Strict.Zipper: root :: Ord k => Zipper k a -> TreeMap k a
+ Data.TreeMap.Strict.Zipper: type Axis k a = Zipper k a -> [Zipper k a]
+ Data.TreeMap.Strict.Zipper: type AxisAlt f k a = Zipper k a -> f (Zipper k a)
+ Data.TreeMap.Strict.Zipper: zipath :: Zipper k a -> [k]
- Data.TreeMap.Strict: type Path = NonEmpty
+ Data.TreeMap.Strict: type Path k = NonNull [k]
- Data.TreeMap.Strict.Zipper: Zipper :: [Zipper_Step k a] -> TreeMap k a -> Zipper k a
+ Data.TreeMap.Strict.Zipper: Zipper :: [Cursor k a] -> TreeMap k a -> Zipper k a
- Data.TreeMap.Strict.Zipper: [zipper_path] :: Zipper k a -> [Zipper_Step k a]
+ Data.TreeMap.Strict.Zipper: [zipper_path] :: Zipper k a -> [Cursor k a]
- Data.TreeMap.Strict.Zipper: infixl 5 `zipper_at`
+ Data.TreeMap.Strict.Zipper: infixl 5 `axis_at`
- Data.TreeMap.Strict.Zipper: zipper_null :: (Zipper k a -> [Zipper k a]) -> Zipper k a -> Bool
+ Data.TreeMap.Strict.Zipper: zipper_null :: Axis k a -> Zipper k a -> Bool

Files

Data/TreeMap/Strict.hs view
@@ -6,56 +6,69 @@  -- | This module implements a strict 'TreeMap', -- which is like a 'Map'--- but whose key is now a 'NonEmpty' list of 'Map' keys (a 'Path')+-- but whose key is now a 'NonNull' list of 'Map' keys (a 'Path') -- enabling the possibility to gather mapped values -- by 'Path' prefixes (inside a 'Node'). module Data.TreeMap.Strict where -import           Control.Applicative (Applicative(..))-import           Control.DeepSeq (NFData(..))-import           Control.Monad (Monad(..))-import           Data.Bool-import           Data.Data (Data)-import           Data.Eq (Eq)-import           Data.Foldable (Foldable, foldMap)-import           Data.Function (($), (.), const, flip, id)-import           Data.Functor (Functor(..), (<$>))-import qualified Data.List-import qualified Data.List.NonEmpty-import           Data.List.NonEmpty (NonEmpty(..))-import           Data.Map.Strict (Map)+import Control.Applicative (Applicative(..), Alternative((<|>)))+import Control.DeepSeq (NFData(..))+import Control.Monad (Monad(..))+import Data.Bool+import Data.Data (Data)+import Data.Eq (Eq(..))+import Data.Foldable (Foldable, foldMap)+import Data.Function (($), (.), const, flip, id)+import Data.Functor (Functor(..), (<$>))+import Data.Map.Strict (Map)+import Data.Maybe (Maybe(..), maybe)+import Data.Monoid (Monoid(..))+import Data.NonNull (NonNull, nuncons, toNullable)+import Data.Ord (Ord(..))+import Data.Semigroup (Semigroup(..))+import Data.Sequences (reverse)+import Data.Traversable (Traversable(..))+import Data.Typeable (Typeable)+import Prelude (Int, Num(..), seq)+import Text.Show (Show(..))+import qualified Control.Applicative as App+import qualified Data.List as List import qualified Data.Map.Strict as Map-import           Data.Maybe (Maybe(..), maybe)-import           Data.Monoid (Monoid(..))-import           Data.Ord (Ord(..))+import qualified Data.NonNull as NonNull import qualified Data.Strict.Maybe as Strict-import           Data.Traversable (Traversable(..))-import           Data.Typeable (Typeable)-import           Prelude (Int, Num(..), seq)-import           Text.Show (Show(..))  -- @Data.Strict@ orphan instances deriving instance Data x => Data (Strict.Maybe x) deriving instance Typeable Strict.Maybe-instance Monoid x => Monoid (Strict.Maybe x) where-	mempty = Strict.Nothing-	mappend (Strict.Just x) (Strict.Just y) = Strict.Just (x `mappend` y)-	mappend x Strict.Nothing = x-	mappend Strict.Nothing y = y+instance Semigroup x => Semigroup (Strict.Maybe x) where+	Strict.Just x <> Strict.Just y = Strict.Just (x <> y)+	x <> Strict.Nothing = x+	Strict.Nothing <> y = y+instance Semigroup x => Monoid (Strict.Maybe x) where+	mempty  = Strict.Nothing+	mappend = (<>) instance NFData x => NFData (Strict.Maybe x) where-	rnf Strict.Nothing = ()+	rnf Strict.Nothing  = () 	rnf (Strict.Just x) = rnf x+instance Applicative Strict.Maybe where+	pure = Strict.Just+	Strict.Just f <*> Strict.Just x = Strict.Just (f x)+	_ <*> _ = Strict.Nothing+instance Alternative Strict.Maybe where+	empty = Strict.Nothing+	x <|> y = if Strict.isJust x then x else y  -- * Type 'TreeMap'- newtype TreeMap k x  =      TreeMap (Map k (Node k x))- deriving (Data, Eq, Show, Typeable)+ deriving (Data, Eq, Ord, Show, Typeable) +instance (Ord k, Semigroup v) => Semigroup (TreeMap k v) where+	(<>) = union (<>) instance (Ord k, Monoid v) => Monoid (TreeMap k v) where 	mempty = empty 	mappend = union mappend-	-- mconcat = Data.List.foldr mappend mempty+	-- mconcat = List.foldr mappend mempty instance Ord k => Functor (TreeMap k) where 	fmap f (TreeMap m) = TreeMap $ fmap (fmap f) m instance Ord k => Foldable (TreeMap k) where@@ -66,18 +79,16 @@ 	rnf (TreeMap m) = rnf m  -- * Type 'Path'- -- | A 'Path' is a non-empty list of 'Map' keys.-type Path = NonEmpty+type Path k = NonNull [k] +-- | 'Path' constructor. path :: k -> [k] -> Path k-path = (:|)--list :: Path k -> [k]-list = Data.List.NonEmpty.toList+path = NonNull.ncons -reverse :: Path k -> Path k-reverse = Data.List.NonEmpty.reverse+-- | Convenient alias.+(<|) :: k -> [k] -> Path k+(<|) = path  -- * Type 'Node' data Node k x@@ -85,15 +96,17 @@  {   node_size        :: !Int -- ^ The number of non-'Strict.Nothing' 'node_value's reachable from this 'Node'.  ,   node_value       :: !(Strict.Maybe x) -- ^ Some value, or 'Strict.Nothing' if this 'Node' is intermediary.  ,   node_descendants :: !(TreeMap k x) -- ^ Descendants 'Node's.- } deriving (Data, Eq, Show, Typeable)+ } deriving (Data, Eq, Ord, Show, Typeable) -instance (Ord k, Monoid v) => Monoid (Node k v) where-	mempty = node Strict.Nothing (TreeMap mempty)-	mappend+instance (Ord k, Semigroup v) => Semigroup (Node k v) where+	(<>) 	 Node{node_value=x0, node_descendants=m0} 	 Node{node_value=x1, node_descendants=m1} =-		node (x0 `mappend` x1) (union const m0 m1)-	-- mconcat = Data.List.foldr mappend mempty+		node (x0 <> x1) (union const m0 m1)+instance (Ord k, Semigroup v) => Monoid (Node k v) where+	mempty = node Strict.Nothing (TreeMap mempty)+	mappend = (<>)+	-- mconcat = List.foldr mappend mempty instance Ord k => Functor (Node k) where 	fmap f Node{node_value=x, node_descendants=m, node_size} = 		Node@@ -124,13 +137,13 @@ 	 , node_descendants 	 } -node_empty :: Node k x-node_empty = node Strict.Nothing empty+nodeEmpty :: Node k x+nodeEmpty = 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) $+nodeLookup :: Ord k => [k] -> Node k x -> Strict.Maybe (Node k x)+nodeLookup [] n = Strict.Just n+nodeLookup (k:ks) Node{node_descendants=TreeMap m} =+	maybe Strict.Nothing (nodeLookup ks) $ 	Map.lookup k m  -- * Construct@@ -151,31 +164,41 @@ -- merging values if the given 'TreeMap' already associates the given 'Path' -- with a non-'Strict.Nothing' 'node_value'. insert :: Ord k => (x -> x -> x) -> Path k -> x -> TreeMap k x -> TreeMap k x-insert merge (k:|[]) x (TreeMap m) =-	TreeMap $-	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) =+insert merge p x (TreeMap m) = 	TreeMap $-	Map.insertWith (\_ Node{..} -> node node_value $-		insert merge (path k' ks) x node_descendants)-	 k-	 (node Strict.Nothing (insert merge (path k' ks) x empty))-	 m+	case nuncons p of+	 (k, Nothing) ->+		Map.insertWith (\_ Node{..} -> node+			 (Strict.maybe (Strict.Just x) (Strict.Just . merge x) node_value)+			 node_descendants)+		 k (leaf x) m+	 (k, Just p') ->+		Map.insertWith (\_ Node{..} -> node node_value $+			insert merge p' x node_descendants)+		 k (node Strict.Nothing (insert merge p' x empty)) m --- | Return a 'TreeMap' associating for each tuple of the given list--- the 'Path' to the value,--- merging values of identical 'Path's (in respective order).-from_List :: Ord k => (x -> x -> x) -> [(Path k, x)] -> TreeMap k x-from_List merge = Data.List.foldl (\acc (p, x) -> insert merge p x acc) empty+-- | Return a 'TreeMap' from a list of 'Path'/value pairs,+-- with a combining function called on the leftest and rightest values+-- when their 'Path's are identical.+fromList :: Ord k => (x -> x -> x) -> [(Path k, x)] -> TreeMap k x+fromList merge = List.foldl' (\acc (p,x) -> insert merge p x acc) empty --- | Return a 'TreeMap' associating for each key and value of the given 'Map'--- 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 = Map.foldlWithKey (\acc p x -> insert merge p x acc) empty+-- | Return a 'TreeMap' from a 'Map' mapping 'Path' to value.+fromMap :: Ord k => Map (Path k) x -> TreeMap k x+fromMap = go . Map.toList+	where+	go :: Ord k => [(Path k,x)] -> TreeMap k x+	go m =+		TreeMap $ Map.fromAscListWith+		 (\Node{node_value=vn, node_descendants=mn}+		   Node{node_value=vo, node_descendants=mo} ->+			node (vn <|> vo) $ union const mn mo) $+		(<$> m) $ \(p,x) ->+			let (p0,mps) = nuncons p in+			case mps of+			 Nothing -> (p0,node (Strict.Just x) empty)+			 Just ps -> (p0,node Strict.Nothing $ go [(ps,x)])+-- fromMap = Map.foldlWithKey (\acc p x -> insert const p x acc) empty  -- * Size @@ -183,9 +206,9 @@ nodes :: TreeMap k x -> Map k (Node k x) nodes (TreeMap m) = m --- | Return 'True' iif. the given 'TreeMap' is 'empty'.+-- | Return 'True' iif. the given 'TreeMap' is of 'size' @0@. null :: TreeMap k x -> Bool-null (TreeMap m) = Map.null m+null m = size m == 0  -- | Return the number of non-'Strict.Nothing' 'node_value's in the given 'TreeMap'. --@@ -196,16 +219,20 @@ -- * 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 $ Map.lookup k m-find (k:|k':ks) (TreeMap m) =-	maybe Strict.Nothing (find (path k' ks) . node_descendants) $-	Map.lookup k m+lookup :: Ord k => Path k -> TreeMap k x -> Strict.Maybe x+lookup p (TreeMap m) =+	maybe Strict.Nothing nod_val $ Map.lookup k m+	where+	(k, mp') = nuncons p+	nod_val =+		case mp' of+		 Nothing -> node_value+		 Just p' -> lookup p' . node_descendants  -- | Return the values (if any) associated with the prefixes of the given 'Path' (included).-find_along :: Ord k => Path k -> TreeMap k x -> [x]-find_along p (TreeMap tm) =-	go (list p) tm+lookupAlong :: Ord k => Path k -> TreeMap k x -> [x]+lookupAlong p (TreeMap tm) =+	go (toNullable p) tm 	where 		go :: Ord k => [k] -> Map k (Node k x) -> [x] 		go [] _m = []@@ -217,11 +244,11 @@ 				go ks $ nodes (node_descendants nod)  -- | 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) =-	Map.lookup k m >>=-	find_node (path k' ks) . node_descendants+lookupNode :: Ord k => Path k -> TreeMap k x -> Maybe (Node k x)+lookupNode p (TreeMap m) =+	case nuncons p of+	 (k, Nothing) -> Map.lookup k m+	 (k, Just p') -> Map.lookup k m >>= lookupNode p' . node_descendants  -- * Union @@ -240,9 +267,9 @@  -- | Return the 'union' of the given 'TreeMap's. ----- NOTE: use 'Data.List.foldl'' to reduce demand on the control-stack.+-- NOTE: use |List.foldl'| to reduce demand on the control-stack. unions :: Ord k => (x -> x -> x) -> [TreeMap k x] -> TreeMap k x-unions merge = Data.List.foldl' (union merge) empty+unions merge = List.foldl' (union merge) empty  -- foldl' :: (a -> b -> a) -> a -> [b] -> a -- foldl' f = go@@ -270,26 +297,26 @@ -- -- WARNING: the function mapping 'Path' sections must be monotonic, -- like in 'Map.mapKeysMonotonic'.-map_monotonic :: (Ord k, Ord l) => (k -> l) -> (x -> y) -> TreeMap k x -> TreeMap l y-map_monotonic fk fx =+mapMonotonic :: (Ord k, Ord l) => (k -> l) -> (x -> y) -> TreeMap k x -> TreeMap l y+mapMonotonic fk fx = 	TreeMap . 	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+		 , node_descendants = mapMonotonic fk fx m 		 }) . 	nodes  -- | Return the given 'TreeMap' with each 'node_value' -- mapped by the given function supplied with -- the already mapped 'node_descendants' of the current 'Node'.-map_by_depth_first :: Ord k => (TreeMap k y -> Strict.Maybe x -> y) -> TreeMap k x -> TreeMap k y-map_by_depth_first f =+mapByDepthFirst :: Ord k => (TreeMap k y -> Strict.Maybe x -> y) -> TreeMap k x -> TreeMap k y+mapByDepthFirst f = 	TreeMap . 	Map.map 	 (\Node{node_value, node_descendants} ->-		let m = map_by_depth_first f node_descendants in+		let m = mapByDepthFirst f node_descendants in 		node (Strict.Just $ f m node_value) m) . 	nodes @@ -297,7 +324,7 @@  alterl_path :: Ord k => (Strict.Maybe x -> Strict.Maybe x) -> Path k -> TreeMap k x -> TreeMap k x alterl_path fct =-	go fct . list+	go fct . toNullable 	where 		go :: Ord k 		 => (Strict.Maybe x -> Strict.Maybe x) -> [k]@@ -328,8 +355,8 @@ -- | Return the given accumulator folded by the given function -- applied on non-'Strict.Nothing' 'node_value's -- from left to right through the given 'TreeMap'.-foldl_with_Path :: Ord k => (a -> Path k -> x -> a) -> a -> TreeMap k x -> a-foldl_with_Path =+foldlWithPath :: Ord k => (a -> Path k -> x -> a) -> a -> TreeMap k x -> a+foldlWithPath = 	foldp [] 	where 		foldp :: Ord k@@ -344,8 +371,8 @@ -- | Return the given accumulator folded by the given function -- applied on non-'Strict.Nothing' 'Node's and 'node_value's -- from left to right through the given 'TreeMap'.-foldl_with_Path_and_Node :: Ord k => (a -> Node k x -> Path k -> x -> a) -> a -> TreeMap k x -> a-foldl_with_Path_and_Node =+foldlWithPathAndNode :: Ord k => (a -> Node k x -> Path k -> x -> a) -> a -> TreeMap k x -> a+foldlWithPathAndNode = 	foldp [] 	where 		foldp :: Ord k@@ -360,8 +387,8 @@ -- | Return the given accumulator folded by the given function -- applied on non-'Strict.Nothing' 'node_value's -- from right to left through the given 'TreeMap'.-foldr_with_Path :: Ord k => (Path k -> x -> a -> a) -> a -> TreeMap k x -> a-foldr_with_Path =+foldrWithPath :: Ord k => (Path k -> x -> a -> a) -> a -> TreeMap k x -> a+foldrWithPath = 	foldp [] 	where 		foldp :: Ord k@@ -376,8 +403,8 @@ -- | Return the given accumulator folded by the given function -- applied on non-'Strict.Nothing' 'Node's and 'node_value's -- from right to left through the given 'TreeMap'.-foldr_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> a -> a) -> a -> TreeMap k x -> a-foldr_with_Path_and_Node =+foldrWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> a -> a) -> a -> TreeMap k x -> a+foldrWithPathAndNode = 	foldp [] 	where 		foldp :: Ord k@@ -392,9 +419,9 @@ -- | Return the given accumulator folded by the given function -- applied on non-'Strict.Nothing' 'node_value's -- from left to right along the given 'Path'.-foldl_path :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a-foldl_path fct =-	go fct [] . list+foldlPath :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a+foldlPath fct =+	go fct [] . toNullable 	where 		go :: Ord k 		 => (Path k -> x -> a -> a) -> [k] -> [k]@@ -411,9 +438,9 @@ -- | Return the given accumulator folded by the given function -- applied on non-'Strict.Nothing' 'node_value's -- from right to left along the given 'Path'.-foldr_path :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a-foldr_path fct =-	go fct [] . list+foldrPath :: Ord k => (Path k -> x -> a -> a) -> Path k -> TreeMap k x -> a -> a+foldrPath fct =+	go fct [] . toNullable 	where 		go :: Ord k 		 => (Path k -> x -> a -> a) -> [k] -> [k]@@ -433,11 +460,11 @@ -- leading to a non-'Strict.Nothing' 'node_value' in the given 'TreeMap', -- with its value mapped by the given function. flatten :: Ord k => (x -> y) -> TreeMap k x -> Map (Path k) y-flatten = flatten_with_Path . const+flatten = flattenWithPath . const  -- | Like 'flatten' but with also the current 'Path' given to the mapping function.-flatten_with_Path :: Ord k => (Path k -> x -> y) -> TreeMap k x -> Map (Path k) y-flatten_with_Path =+flattenWithPath :: Ord k => (Path k -> x -> y) -> TreeMap k x -> Map (Path k) y+flattenWithPath = 	flat_map [] 	where 		flat_map :: Ord k@@ -463,34 +490,34 @@ --   passing the given predicate. filter :: Ord k => (x -> Bool) -> TreeMap k x -> TreeMap k x filter f =-	map_Maybe_with_Path+	mapMaybeWithPath 	 (\_p x -> if f x then Strict.Just x else Strict.Nothing)  -- | Like 'filter' but with also the current 'Path' given to the predicate.-filter_with_Path :: Ord k => (Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x-filter_with_Path f =-	map_Maybe_with_Path+filterWithPath :: Ord k => (Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x+filterWithPath f =+	mapMaybeWithPath 	 (\p x -> if f p x then Strict.Just x else Strict.Nothing) --- | Like 'filter_with_Path' but with also the current 'Node' given to the predicate.-filter_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x-filter_with_Path_and_Node f =-	map_Maybe_with_Path_and_Node+-- | Like 'filterWithPath' but with also the current 'Node' given to the predicate.+filterWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> Bool) -> TreeMap k x -> TreeMap k x+filterWithPathAndNode f =+	mapMaybeWithPathAndNode 	 (\n p x -> if f n p x then Strict.Just x else Strict.Nothing)  -- | Return the given 'TreeMap' --   mapping its non-'Strict.Nothing' 'node_value's --   and keeping only the non-'Strict.Nothing' results.-map_Maybe :: Ord k => (x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y-map_Maybe = map_Maybe_with_Path . const+mapMaybe :: Ord k => (x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y+mapMaybe = mapMaybeWithPath . const --- | Like 'map_Maybe' but with also the current 'Path' given to the predicate.-map_Maybe_with_Path :: Ord k => (Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y-map_Maybe_with_Path = map_Maybe_with_Path_and_Node . const+-- | Like 'mapMaybe' but with also the current 'Path' given to the predicate.+mapMaybeWithPath :: Ord k => (Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y+mapMaybeWithPath = mapMaybeWithPathAndNode . const --- | Like 'map_Maybe_with_Path' but with also the current 'Node' given to the predicate.-map_Maybe_with_Path_and_Node :: Ord k => (Node k x -> Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y-map_Maybe_with_Path_and_Node =+-- | Like 'mapMaybeWithPath' but with also the current 'Node' given to the predicate.+mapMaybeWithPathAndNode :: Ord k => (Node k x -> Path k -> x -> Strict.Maybe y) -> TreeMap k x -> TreeMap k y+mapMaybeWithPathAndNode = 	go [] 	where 		go :: Ord k@@ -515,3 +542,22 @@ 					then Nothing 					else Just Node{node_value=Strict.Nothing, node_descendants, node_size} 			 ) m++-- * Intersection++(\\) :: Ord k => TreeMap k x -> TreeMap k y -> TreeMap k x+(\\) = intersection const++intersection ::+ Ord k =>+ (Strict.Maybe x -> Strict.Maybe y -> Strict.Maybe z) ->+ TreeMap k x -> TreeMap k y -> TreeMap k z+intersection merge (TreeMap x) (TreeMap y) =+	TreeMap $+	Map.intersectionWith+	 (\xn yn ->+		node (node_value xn `merge` node_value yn) $+		intersection merge+		 (node_descendants xn)+		 (node_descendants yn))+	 x y
− Data/TreeMap/Strict/Test.hs
@@ -1,154 +0,0 @@-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-module Strict.Test where--import Data.Function (($), id, const)-import Data.Int (Int)-import Data.List.NonEmpty (NonEmpty(..))-import qualified Data.Map.Strict as Map-import Data.Monoid ((<>))-import qualified Data.Strict.Maybe as Strict-import Prelude (Integer, undefined)-import Test.Tasty-import Test.Tasty.HUnit--import qualified Data.TreeMap.Strict as TreeMap--tests :: TestTree-tests = testGroup "Strict"- [ testGroup "insert"-	 [ testCase "[] 0" $-			TreeMap.insert const ((0::Int):|[]) () TreeMap.empty-		 @?= (TreeMap.TreeMap $ Map.fromList [ (0::Int, TreeMap.leaf ()) ])-	 , testCase "[] 0/1" $-			TreeMap.insert const ((0::Int):|[1]) () TreeMap.empty-		 @?=-			(TreeMap.TreeMap $-			Map.fromList-			 [ (0::Int, TreeMap.Node-				 { TreeMap.node_value = Strict.Nothing-				 , TreeMap.node_size = 1-				 , TreeMap.node_descendants =-					TreeMap.singleton ((1::Int):|[]) ()-				 })-			 ])-	 ]- , testGroup "map_by_depth_first"-	 [ testCase "[0, 0/1, 0/1/2, 1, 1/2/3]" $-			TreeMap.map_by_depth_first-			 (\descendants value ->-				Map.foldl'-				 (\acc v -> (<>) acc $-					Strict.fromMaybe undefined $-					TreeMap.node_value v-				 )-				 (Strict.fromMaybe [] value)-				 (TreeMap.nodes descendants)-			 )-			(TreeMap.from_List const-			 [ ((0::Integer):|[], [0::Integer])-			 , (0:|[1], [0,1])-			 , (0:|[1,2], [0,1,2])-			 , (1:|[], [1])-			 , (1:|[2,3], [1,2,3])-			 ])-		 @?=-			TreeMap.from_List const-			 [ ((0::Integer):|[], [0,0,1,0,1,2])-			 , (0:|[1], [0,1,0,1,2])-			 , (0:|[1,2], [0,1,2])-			 , (1:|[], [1,1,2,3])-			 , (1:|[2], [1,2,3])-			 , (1:|[2,3], [1,2,3])-			 ]-	 , testCase "[0/0]" $-			TreeMap.map_by_depth_first-			 (\descendants value ->-				Map.foldl'-				 (\acc v -> (<>) acc $-					Strict.fromMaybe undefined $-					TreeMap.node_value v-				 )-				 (Strict.fromMaybe [] value)-				 (TreeMap.nodes descendants)-			 )-			(TreeMap.from_List const-			 [ ((0::Integer):|[0], [0::Integer,0])-			 ])-		 @?=-			TreeMap.from_List const-			 [ ((0::Integer):|[], [0,0])-			 , (0:|[0], [0,0])-			 ]-	 ]- , testGroup "flatten"-	 [ testCase "[0, 0/1, 0/1/2]" $-			TreeMap.flatten id-			(TreeMap.from_List const-			 [ ((0::Integer):|[], ())-			 , (0:|[1], ())-			 , (0:|[1,2], ())-			 ])-		 @?=-			Map.fromList-			 [ ((0::Integer):|[], ())-			 , (0:|[1], ())-			 , (0:|[1,2], ())-			 ]-	 , testCase "[1, 1/2, 1/22, 1/2/3, 1/2/33, 11, 11/2, 11/2/3, 11/2/33]" $-			TreeMap.flatten id-			(TreeMap.from_List const-			 [ ((1::Integer):|[], ())-			 , (1:|[2], ())-			 , (1:|[22], ())-			 , (1:|[2,3], ())-			 , (1:|[2,33], ())-			 , (11:|[], ())-			 , (11:|[2], ())-			 , (11:|[2,3], ())-			 , (11:|[2,33], ())-			 ])-		 @?=-			Map.fromList-			 [ ((1::Integer):|[], ())-			 , (1:|[2], ())-			 , (1:|[22], ())-			 , (1:|[2,3], ())-			 , (1:|[2,33], ())-			 , (11:|[], ())-			 , (11:|[2], ())-			 , (11:|[2,3], ())-			 , (11:|[2,33], ())-			 ]-	 ]- , testGroup "find_along"-	 [ testCase "0/1/2/3 [0, 0/1, 0/1/2, 0/1/2/3]" $-			TreeMap.find_along-			 (0:|[1,2,3])-			(TreeMap.from_List const-			 [ ((0::Integer):|[], [0])-			 , (0:|[1], [0,1])-			 , (0:|[1,2], [0,1,2])-			 , (0:|[1,2,3], [0,1,2,3])-			 ])-		 @?=-			[ [0::Integer]-			, [0,1]-			, [0,1,2]-			, [0,1,2,3]-			]-	 , testCase "0/1/2/3 [0, 0/1]" $-			TreeMap.find_along-			 (0:|[1,2,3])-			(TreeMap.from_List const-			 [ ((0::Integer):|[], [0])-			 , (0:|[1], [0,1])-			 ])-		 @?=-			[ [0::Integer]-			, [0,1]-			]-	 ]- ]
Data/TreeMap/Strict/Zipper.hs view
@@ -4,218 +4,212 @@  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 Control.Applicative (Applicative(..), Alternative(..))+import Control.Monad (Monad(..), (>=>))+import Data.Bool (Bool)+import Data.Data (Data)+import Data.Eq (Eq)+import Data.Function (($), (.))+import Data.Functor ((<$>))+import Data.Int (Int)+import Data.Maybe (Maybe(..), maybe)+import Data.NonNull (nuncons)+import Data.Ord (Ord(..))+import Data.Tuple (fst)+import Data.Typeable (Typeable)+import Text.Show (Show(..)) 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(..)) -import           Data.TreeMap.Strict (TreeMap(..))+import Data.TreeMap.Strict (TreeMap(..), Node(..), Path) import qualified Data.TreeMap.Strict as TreeMap  -- * Type 'Zipper'- data Zipper k a  =   Zipper- {   zipper_path :: [Zipper_Step k a]+ {   zipper_path :: [Cursor k a]  ,   zipper_curr :: TreeMap k a  } deriving (Data, Eq, Show, Typeable)  zipper :: TreeMap k a -> Zipper k a zipper = Zipper [] -zipper_root :: Ord k => Zipper k a -> TreeMap k a-zipper_root = zipper_curr . List.last . zipper_ancestor_or_self+root :: Ord k => Zipper k a -> TreeMap k a+root = zipper_curr . List.last . axis_ancestor_or_self -path_of_zipper :: Zipper k x -> [k]-path_of_zipper z =-	fst . zipper_step_self <$>+zipath :: Zipper k a -> [k]+zipath z =+	fst . cursor_self <$> 	List.reverse (zipper_path z) --- * Type 'Zipper_Step'+current :: Zipper k a -> TreeMap k a+current = zipper_curr -data Zipper_Step k a- =   Zipper_Step- {   zipper_step_prec :: TreeMap k a- ,   zipper_step_self :: (k, TreeMap.Node k a)- ,   zipper_step_foll :: TreeMap k a+-- * Type 'Cursor'+data Cursor k a+ =   Cursor+ {   cursor_precedings :: TreeMap k a+ ,   cursor_self       :: (k, Node k a)+ ,   cursor_followings :: TreeMap k a  } deriving (Data, Eq, Show, Typeable)  -- * Axis+type Axis k a = Zipper k a -> [Zipper k a]+type AxisAlt f k a = Zipper k a -> f (Zipper k a)  -- | Collect all 'Zipper's along a given axis, --   including the first 'Zipper'.-zipper_collect :: (z -> Maybe z) -> z -> [z]-zipper_collect f z = z : maybe [] (zipper_collect f) (f z)+axis_collect :: (z -> Maybe z) -> z -> [z]+axis_collect f z = z : maybe [] (axis_collect f) (f z)  -- | Collect all 'Zipper's along a given axis, --   excluding the first 'Zipper'.-zipper_collect_without_self :: (z -> Maybe z) -> z -> [z]-zipper_collect_without_self f z = maybe [] (zipper_collect f) (f z)---- ** Axis self+axis_collect_without_self :: (z -> Maybe z) -> z -> [z]+axis_collect_without_self f z = maybe [] (axis_collect f) (f z) -zipper_self :: Zipper k a -> TreeMap.Node k a-zipper_self z =+-- ** Axis @self@+axis_self :: Zipper k a -> Node k a+axis_self z = 	case z of 	 Zipper{ zipper_path=-	         Zipper_Step{zipper_step_self=(_, nod)}+	         Cursor{cursor_self=(_, nod)} 	         : _ } -> nod-	 _ -> TreeMap.node_empty---- ** Axis child+	 _ -> TreeMap.nodeEmpty -zipper_child :: Ord k => Zipper k a -> [Zipper k a]-zipper_child z =-	maybeToList (zipper_child_first z)-	>>= zipper_collect zipper_foll+-- ** Axis @child@+axis_child :: Ord k => Axis k a+axis_child z =+	axis_child_first z >>=+	axis_collect axis_following_sibling_nearest -zipper_child_lookup+axis_child_lookup  :: (Ord k, Alternative f)- => k -> Zipper k a -> f (Zipper k a)-zipper_child_lookup k (Zipper path (TreeMap m)) =+ => k -> AxisAlt f k a+axis_child_lookup k (Zipper path (TreeMap m)) = 	case Map.splitLookup k m of 	 (_, Nothing, _) -> empty 	 (ps, Just s, fs) -> 		pure Zipper-		 { zipper_path = Zipper_Step (TreeMap ps) (k, s) (TreeMap fs) : path+		 { zipper_path = Cursor (TreeMap ps) (k, s) (TreeMap fs) : path 		 , zipper_curr = TreeMap.node_descendants s 		 } -zipper_child_first :: Alternative f => Zipper k a -> f (Zipper k a)-zipper_child_first (Zipper path (TreeMap m)) =+axis_child_lookups :: (Ord k, Alternative f, Monad f) => Path k -> AxisAlt f k a+axis_child_lookups p =+	case nuncons p of+	 (k, Nothing) -> axis_child_lookup k+	 (k, Just p') -> axis_child_lookup k >=> axis_child_lookups p'++axis_child_first :: Alternative f => AxisAlt f k a+axis_child_first (Zipper path (TreeMap m)) = 	case Map.minViewWithKey m of 	 Nothing -> empty 	 Just ((k', s'), fs') -> 		pure Zipper-		 { zipper_path = Zipper_Step TreeMap.empty (k', s') (TreeMap fs') : path+		 { zipper_path = Cursor TreeMap.empty (k', s') (TreeMap fs') : path 		 , zipper_curr = TreeMap.node_descendants s' 		 } -zipper_child_last :: Alternative f => Zipper k a -> f (Zipper k a)-zipper_child_last (Zipper path (TreeMap m)) =+axis_child_last :: Alternative f => AxisAlt f k a+axis_child_last (Zipper path (TreeMap m)) = 	case Map.maxViewWithKey m of 	 Nothing -> empty 	 Just ((k', s'), ps') -> 		pure Zipper-		 { zipper_path = Zipper_Step (TreeMap ps') (k', s') TreeMap.empty : path+		 { zipper_path = Cursor (TreeMap ps') (k', s') TreeMap.empty : path 		 , zipper_curr = TreeMap.node_descendants s' 		 } --- ** Axis ancestor--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 a -> [Zipper k a]-zipper_ancestor_or_self = zipper_collect zipper_parent+-- ** Axis @ancestor@+axis_ancestor :: Ord k => Axis k a+axis_ancestor = axis_collect_without_self axis_parent --- ** Axis descendant+axis_ancestor_or_self :: Ord k => Axis k a+axis_ancestor_or_self = axis_collect axis_parent -zipper_descendant_or_self :: Ord k => Zipper k a -> [Zipper k a]-zipper_descendant_or_self =+-- ** Axis @descendant@+axis_descendant_or_self :: Ord k => Axis k a+axis_descendant_or_self = 	collect_child [] 	where 		collect_child acc z = 			z : maybe acc 			 (collect_foll acc)-			 (zipper_child_first z)+			 (axis_child_first z) 		collect_foll  acc z = 			collect_child 			 (maybe acc 				 (collect_foll acc)-				 (zipper_foll z)+				 (axis_following_sibling_nearest z) 			 ) z -zipper_descendant_or_self_reverse :: Ord k => Zipper k a -> [Zipper k a]-zipper_descendant_or_self_reverse z =+axis_descendant_or_self_reverse :: Ord k => Axis k a+axis_descendant_or_self_reverse z = 	z : List.concatMap-	 zipper_descendant_or_self_reverse-	 (List.reverse $ zipper_child z)--zipper_descendant :: Ord k => Zipper k a -> [Zipper k a]-zipper_descendant = List.tail . zipper_descendant_or_self--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_lookup k-	 k':ks' -> zipper_child_lookup k >=> zipper_descendant_lookup (k':|ks')+	 axis_descendant_or_self_reverse+	 (List.reverse $ axis_child z) --- ** Axis preceding+axis_descendant :: Ord k => Axis k a+axis_descendant = List.tail . axis_descendant_or_self -zipper_prec :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a)-zipper_prec (Zipper path _curr) =+-- ** Axis @preceding@+axis_preceding_sibling_nearest :: (Ord k, Alternative f) => AxisAlt f k a+axis_preceding_sibling_nearest (Zipper path _curr) = 	case path of 	 [] -> empty-	 Zipper_Step (TreeMap ps) (k, s) (TreeMap fs):steps ->+	 Cursor (TreeMap ps) (k, s) (TreeMap fs):steps -> 		case Map.maxViewWithKey ps of 		 Nothing -> empty 		 Just ((k', s'), ps') -> 			pure Zipper-			 { zipper_path = Zipper_Step (TreeMap ps')+			 { zipper_path = Cursor (TreeMap ps') 			                             (k', s') 			                             (TreeMap $ Map.insert k s fs) 			                 : steps 			 , zipper_curr = TreeMap.node_descendants s' 			 } -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 a -> [Zipper k a]-zipper_preceding_sibling = zipper_collect_without_self zipper_prec+axis_preceding_sibling :: Ord k => Axis k a+axis_preceding_sibling = axis_collect_without_self axis_preceding_sibling_nearest --- ** Axis following+axis_preceding :: Ord k => Axis k a+axis_preceding =+	axis_ancestor_or_self >=>+	axis_preceding_sibling >=>+	axis_descendant_or_self_reverse -zipper_foll :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a)-zipper_foll (Zipper path _curr) =+-- ** Axis @following@+axis_following_sibling_nearest :: (Ord k, Alternative f) => AxisAlt f k a+axis_following_sibling_nearest (Zipper path _curr) = 	case path of 	 [] -> empty-	 Zipper_Step (TreeMap ps) (k, s) (TreeMap fs):steps ->+	 Cursor (TreeMap ps) (k, s) (TreeMap fs):steps -> 		case Map.minViewWithKey fs of 		 Nothing -> empty 		 Just ((k', s'), fs') -> 			pure Zipper-			 { zipper_path = Zipper_Step (TreeMap $ Map.insert k s ps)+			 { zipper_path = Cursor (TreeMap $ Map.insert k s ps) 			                             (k', s') 			                             (TreeMap fs') 			                 : steps 			 , zipper_curr = TreeMap.node_descendants s' 			 } -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 a -> [Zipper k a]-zipper_following_sibling = zipper_collect_without_self zipper_foll+axis_following_sibling :: Ord k => Axis k a+axis_following_sibling = axis_collect_without_self axis_following_sibling_nearest --- ** Axis parent+axis_following :: Ord k => Axis k a+axis_following =+	axis_ancestor_or_self >=>+	axis_following_sibling >=>+	axis_descendant_or_self -zipper_parent :: (Ord k, Alternative f) => Zipper k a -> f (Zipper k a)-zipper_parent (Zipper path curr) =+-- ** Axis @parent@+axis_parent :: (Ord k, Alternative f) => AxisAlt f k a+axis_parent (Zipper path curr) = 	case path of 	 [] -> empty-	 Zipper_Step (TreeMap ps) (k, s) (TreeMap fs):steps ->+	 Cursor (TreeMap ps) (k, s) (TreeMap fs):steps -> 		let nod = TreeMap.node (TreeMap.node_value s) curr in 		pure Zipper 		 { zipper_path = steps@@ -223,21 +217,13 @@ 		 }  -- ** 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`+axis_filter :: Axis k a -> (Zipper k a -> Bool) -> Axis k a+axis_filter axis p z = List.filter p (axis z)+infixl 5 `axis_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`+axis_at :: Alternative f => Axis k a -> Int -> AxisAlt f k a+axis_at axis n z = case List.drop n (axis z) of {[] -> empty; a:_ -> pure a}+infixl 5 `axis_at` -zipper_null- :: (Zipper k a -> [Zipper k a])- -> Zipper k a -> Bool+zipper_null :: Axis k a -> Zipper k a -> Bool zipper_null axis = List.null . axis
− Data/TreeMap/Test.hs
@@ -1,19 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TupleSections #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}-module Test where--import Data.Function (($))-import System.IO (IO)-import Test.Tasty--import qualified Strict.Test as Strict--main :: IO ()-main =-	defaultMain $-	testGroup "TreeMap"-	 [ Strict.tests-	 ]
stack.yaml view
@@ -1,6 +1,3 @@-resolver: lts-7.18-flags: {}+resolver: lts-10.5 packages: - '.'-extra-deps:-extra-package-dbs: []
+ test/HUnit.hs view
@@ -0,0 +1,10 @@+module HUnit where++import Test.Tasty+import qualified HUnit.Strict as Strict++hunits :: TestTree+hunits =+	testGroup "HUnit"+	 [ Strict.hunits+	 ]
+ test/HUnit/Strict.hs view
@@ -0,0 +1,151 @@+module HUnit.Strict where++import Data.Function (($), id, const)+import Data.Int (Int)+import Data.Monoid ((<>))+import Prelude (Integer, undefined)+import qualified Data.Map.Strict as Map+import qualified Data.Strict.Maybe as Strict++import Test.Tasty+import Test.Tasty.HUnit++import Data.TreeMap.Strict (TreeMap(..), (<|))+import qualified Data.TreeMap.Strict as TreeMap++hunits :: TestTree+hunits = testGroup "Strict"+ [ testGroup "insert"+	 [ testCase "[] 0" $+			TreeMap.insert const ((0::Int)<|[]) () TreeMap.empty+		 @?= (TreeMap $ Map.fromList [ (0::Int, TreeMap.leaf ()) ])+	 , testCase "[] 0/1" $+			TreeMap.insert const ((0::Int)<|[1]) () TreeMap.empty+		 @?=+			(TreeMap $+			Map.fromList+			 [ (0::Int, TreeMap.Node+				 { TreeMap.node_value = Strict.Nothing+				 , TreeMap.node_size = 1+				 , TreeMap.node_descendants =+					TreeMap.singleton ((1::Int)<|[]) ()+				 })+			 ])+	 ]+ , testGroup "mapByDepthFirst"+	 [ testCase "[0, 0/1, 0/1/2, 1, 1/2/3]" $+			TreeMap.mapByDepthFirst+			 (\descendants value ->+				Map.foldl'+				 (\acc v -> (<>) acc $+					Strict.fromMaybe undefined $+					TreeMap.node_value v+				 )+				 (Strict.fromMaybe [] value)+				 (TreeMap.nodes descendants)+			 )+			(TreeMap.fromList const+			 [ ((0::Integer)<|[], [0::Integer])+			 , (0<|[1], [0,1])+			 , (0<|[1,2], [0,1,2])+			 , (1<|[], [1])+			 , (1<|[2,3], [1,2,3])+			 ])+		 @?=+			TreeMap.fromList const+			 [ ((0::Integer)<|[], [0,0,1,0,1,2])+			 , (0<|[1], [0,1,0,1,2])+			 , (0<|[1,2], [0,1,2])+			 , (1<|[], [1,1,2,3])+			 , (1<|[2], [1,2,3])+			 , (1<|[2,3], [1,2,3])+			 ]+	 , testCase "[0/0]" $+			TreeMap.mapByDepthFirst+			 (\descendants value ->+				Map.foldl'+				 (\acc v -> (<>) acc $+					Strict.fromMaybe undefined $+					TreeMap.node_value v+				 )+				 (Strict.fromMaybe [] value)+				 (TreeMap.nodes descendants)+			 )+			(TreeMap.fromList const+			 [ ((0::Integer)<|[0], [0::Integer,0])+			 ])+		 @?=+			TreeMap.fromList const+			 [ ((0::Integer)<|[], [0,0])+			 , (0<|[0], [0,0])+			 ]+	 ]+ , testGroup "flatten"+	 [ testCase "[0, 0/1, 0/1/2]" $+			TreeMap.flatten id+			(TreeMap.fromList const+			 [ ((0::Integer)<|[], ())+			 , (0<|[1], ())+			 , (0<|[1,2], ())+			 ])+		 @?=+			Map.fromList+			 [ ((0::Integer)<|[], ())+			 , (0<|[1], ())+			 , (0<|[1,2], ())+			 ]+	 , testCase "[1, 1/2, 1/22, 1/2/3, 1/2/33, 11, 11/2, 11/2/3, 11/2/33]" $+			TreeMap.flatten id+			(TreeMap.fromList const+			 [ ((1::Integer)<|[], ())+			 , (1<|[2], ())+			 , (1<|[22], ())+			 , (1<|[2,3], ())+			 , (1<|[2,33], ())+			 , (11<|[], ())+			 , (11<|[2], ())+			 , (11<|[2,3], ())+			 , (11<|[2,33], ())+			 ])+		 @?=+			Map.fromList+			 [ ((1::Integer)<|[], ())+			 , (1<|[2], ())+			 , (1<|[22], ())+			 , (1<|[2,3], ())+			 , (1<|[2,33], ())+			 , (11<|[], ())+			 , (11<|[2], ())+			 , (11<|[2,3], ())+			 , (11<|[2,33], ())+			 ]+	 ]+ , testGroup "lookupAlong"+	 [ testCase "0/1/2/3 [0, 0/1, 0/1/2, 0/1/2/3]" $+			TreeMap.lookupAlong+			 (0<|[1,2,3])+			(TreeMap.fromList const+			 [ ((0::Integer)<|[], [0])+			 , (0<|[1], [0,1])+			 , (0<|[1,2], [0,1,2])+			 , (0<|[1,2,3], [0,1,2,3])+			 ])+		 @?=+			[ [0::Integer]+			, [0,1]+			, [0,1,2]+			, [0,1,2,3]+			]+	 , testCase "0/1/2/3 [0, 0/1]" $+			TreeMap.lookupAlong+			 (0<|[1,2,3])+			(TreeMap.fromList const+			 [ ((0::Integer)<|[], [0])+			 , (0<|[1], [0,1])+			 ])+		 @?=+			[ [0::Integer]+			, [0,1]+			]+	 ]+ ]
+ test/Main.hs view
@@ -0,0 +1,14 @@+module Main where++import Data.Function (($))+import System.IO (IO)+import Test.Tasty++import HUnit++main :: IO ()+main =+	defaultMain $+	testGroup "TreeMap"+	 [ hunits+	 ]
treemap.cabal view
@@ -1,100 +1,84 @@-author: Julien Moutinho <julm+haskell+treemap@autogeree.net>--- bug-reports: http://bug.autogeree.net/haskell/treemap/-build-type: Simple-cabal-version: >= 1.8+name: treemap+-- PVP:  +-+------- breaking API changes+--       | | +----- non-breaking API additions+--       | | | +--- code changes with no API change+version: 2.4.0.20180213 category: Data Structures--- data-dir: data--- data-files: +synopsis: A tree of Data.Map. description: A tree of Data.Map,- which is like a 'Map'- but whose key is now a 'NonEmpty' list of 'Map' keys (a 'Path')- enabling the possibility to gather mapped values- by 'Path' prefixes (inside a 'Node').-extra-source-files:-  stack.yaml-extra-tmp-files:--- homepage: http://pad.autogeree.net/informatique/haskell/treemap/+             which is like a 'Map'+             but whose key is now a 'NonEmpty' list of 'Map' keys (a 'Path')+             enabling the possibility to gather mapped values+             by 'Path' prefixes (inside a 'Node').+extra-doc-files: license: GPL-3 license-file: COPYING-maintainer: Julien Moutinho <julm+haskell+treemap@autogeree.net>-name: treemap stability: experimental-synopsis: A tree of Data.Map.-tested-with: GHC==8.0.1-version: 2.0.0.20161218+author:      Julien Moutinho <julm+treemap@autogeree.net>+maintainer:  Julien Moutinho <julm+treemap@autogeree.net>+bug-reports: Julien Moutinho <julm+treemap@autogeree.net>+-- homepage: +build-type: Simple+cabal-version: >= 1.10+tested-with: GHC==8.2.2+extra-source-files:+  stack.yaml+extra-tmp-files:+ source-repository head   location: git://git.autogeree.net/haskell/treemap   type:     git -Flag dev-  Default:     False-  Description: Turn on development settings.-  Manual:      True--Flag dump-  Default:     False-  Description: Dump some intermediate files.-  Manual:      True--Flag prof-  Default:     False-  Description: Turn on profiling settings.-  Manual:      True--Flag threaded-  Default:     False-  Description: Enable threads.-  Manual:      True- Library-  extensions: NoImplicitPrelude-  ghc-options: -Wall -fno-warn-tabs-  if flag(dev)-    cpp-options: -DDEVELOPMENT-    ghc-options:-  if flag(dump)-    ghc-options: -ddump-simpl -ddump-stg -ddump-to-file-  if flag(prof)-    cpp-options: -DPROFILING-    ghc-options: -fprof-auto-  -- default-language: Haskell2010   exposed-modules:     Data.TreeMap.Strict     Data.TreeMap.Strict.Zipper+  default-language: Haskell2010+  default-extensions: NoImplicitPrelude+  ghc-options:+    -Wall+    -Wincomplete-uni-patterns+    -Wincomplete-record-updates+    -fno-warn-tabs+    -- -fhide-source-paths   build-depends:-    base >= 4.6 && < 5-    , containers >= 0.5 && < 0.6-    , deepseq-    , semigroups-    , strict-    , transformers >= 0.4 && < 0.6+      base             >= 4.6 && < 5+    , containers       >= 0.5+    , deepseq          >= 1.4+    , mono-traversable >= 1.0+    , semigroups       >= 0.18+    , strict           >= 0.3+    , transformers     >= 0.4  Test-Suite treemap-test   type: exitcode-stdio-1.0-  -- default-language: Haskell2010-  extensions: NoImplicitPrelude-  ghc-options: -Wall -fno-warn-tabs-               -main-is Test-  hs-source-dirs: Data/TreeMap-  main-is: Test.hs+  hs-source-dirs: test+  main-is: Main.hs   other-modules:-    Strict.Test-  if flag(threaded)-    ghc-options: -threaded -rtsopts -with-rtsopts=-N-  if flag(dev)-    cpp-options: -DDEVELOPMENT-    ghc-options:-  if flag(prof)-    cpp-options: -DPROFILING-    ghc-options: -fprof-auto+    HUnit+    HUnit.Strict+  default-language: Haskell2010+  default-extensions:+    NamedFieldPuns+    NoImplicitPrelude+    OverloadedStrings+    ScopedTypeVariables+    TupleSections+  ghc-options:+    -Wall+    -Wincomplete-uni-patterns+    -Wincomplete-record-updates+    -fno-warn-tabs+    -- -fhide-source-paths   build-depends:-    base >= 4.6 && < 5-    , containers >= 0.5 && < 0.6-    , semigroups-    , strict-    , tasty >= 0.11-    , tasty-hunit-    , text-    , transformers >= 0.4 && < 0.6-    , treemap+      treemap+    , base             >= 4.6 && < 5+    , containers       >= 0.5+    , mono-traversable >= 1.0+    , semigroups       >= 0.18+    , strict           >= 0.3+    , tasty            >= 0.11+    , tasty-hunit      >= 0.9+    , text             >= 1.2+    , transformers     >= 0.4