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 +175/−129
- Data/TreeMap/Strict/Test.hs +0/−154
- Data/TreeMap/Strict/Zipper.hs +112/−126
- Data/TreeMap/Test.hs +0/−19
- stack.yaml +1/−4
- test/HUnit.hs +10/−0
- test/HUnit/Strict.hs +151/−0
- test/Main.hs +14/−0
- treemap.cabal +64/−80
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