path-tree (empty) → 0.2.0.0

raw patch · 4 files changed

+177/−0 lines, 4 filesdep +basedep +containersdep +relude

Dependencies added: base, containers, relude

Files

• LICENSE +21/−0
• README.md +2/−0
• path-tree.cabal +84/−0
• src/Data/Tree/Path.hs +70/−0

@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2022 Sridhar Ratnakumar++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,2 @@+# path-tree+

@@ -0,0 +1,84 @@+cabal-version:      2.4+name:               path-tree+version:            0.2.0.0+license:            MIT+copyright:          2022 Sridhar Ratnakumar+maintainer:         srid@srid.ca+author:             Sridhar Ratnakumar+category:           Data Structures++-- A short (one-line) description of the package.+synopsis: `Data.Tree` for file paths++-- A longer description of the package.+description: `Data.Tree` for file paths++-- A URL where users can report bugs.+bug-reports: https://github.com/srid/pathtree++extra-source-files:+  LICENSE+  README.md++library+  build-depends:+    , base >=4.13.0.0 && <=4.18.0.0+    , containers+    , relude++  mixins:+    base hiding (Prelude),+    relude (Relude as Prelude, Relude.Container.One),+    relude++  ghc-options:+    -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns+    -Wmissing-deriving-strategies -Wunused-foralls -Wunused-foralls+    -fprint-explicit-foralls -fprint-explicit-kinds++  default-extensions:+    NoStarIsType+    BangPatterns+    ConstraintKinds+    DataKinds+    DeriveDataTypeable+    DeriveFoldable+    DeriveFunctor+    DeriveGeneric+    DeriveLift+    DeriveTraversable+    DerivingStrategies+    DerivingVia+    EmptyCase+    EmptyDataDecls+    EmptyDataDeriving+    ExistentialQuantification+    ExplicitForAll+    FlexibleContexts+    FlexibleInstances+    GADTSyntax+    GeneralisedNewtypeDeriving+    ImportQualifiedPost+    KindSignatures+    LambdaCase+    MultiParamTypeClasses+    MultiWayIf+    NumericUnderscores+    OverloadedStrings+    PolyKinds+    PostfixOperators+    RankNTypes+    ScopedTypeVariables+    StandaloneDeriving+    StandaloneKindSignatures+    TupleSections+    TypeApplications+    TypeFamilies+    TypeOperators+    ViewPatterns++  exposed-modules:+    Data.Tree.Path++  hs-source-dirs:     src+  default-language:   Haskell2010

@@ -0,0 +1,70 @@+module Data.Tree.Path where++import Data.List qualified as List+import Data.List.NonEmpty qualified as NE+import Data.Tree (Tree (Node))+import Data.Tree qualified as Tree++treeInsertPath :: Eq a => NonEmpty a -> [Tree a] -> [Tree a]+treeInsertPath =+  treeInsertPathMaintainingOrder void++-- | Insert a node by path into a tree with descendants that are ordered.+--+-- Insertion will guarantee that descendants continue to be ordered as expected.+--+-- The order of descendents is determined by the given order function, which+-- takes the path to a node and return that node's order. The intention is to+-- lookup the actual order value which exists *outside* of the tree+-- datastructure itself.+treeInsertPathMaintainingOrder :: (Eq a, Ord ord) => (NonEmpty a -> ord) -> NonEmpty a -> [Tree a] -> [Tree a]+treeInsertPathMaintainingOrder ordF path t =+  orderedTreeInsertPath ordF (toList path) t []+  where+    orderedTreeInsertPath :: (Eq a, Ord b) => (NonEmpty a -> b) -> [a] -> [Tree a] -> [a] -> [Tree a]+    orderedTreeInsertPath _ [] trees _ =+      trees+    orderedTreeInsertPath pathOrder (top : rest) trees ancestors =+      case treeFindChild top trees of+        Nothing ->+          let newChild = Node top $ orderedTreeInsertPath pathOrder rest [] (top : ancestors)+           in sortChildrenOn pathOrder (trees <> one newChild)+        Just (Node _match grandChildren) ->+          let oneDead = treeDeleteChild top trees+              newChild = Node top $ orderedTreeInsertPath pathOrder rest grandChildren (top : ancestors)+           in sortChildrenOn pathOrder (oneDead <> one newChild)+      where+        treeFindChild x xs =+          List.find (\n -> Tree.rootLabel n == x) xs+        sortChildrenOn f =+          sortOn $ (\s -> f $ NE.reverse $ s :| ancestors) . Tree.rootLabel++treeDeletePath :: Eq a => NonEmpty a -> [Tree a] -> [Tree a]+treeDeletePath =+  treeDeletePathWithLastBehavingAs $ \lastInPath ts ->+    List.deleteBy (\x y -> Tree.rootLabel x == Tree.rootLabel y) (Node lastInPath []) ts++treeDeleteLeafPath :: Eq a => NonEmpty a -> [Tree a] -> [Tree a]+treeDeleteLeafPath =+  treeDeletePathWithLastBehavingAs $ \lastInPath ts ->+    case ts of+      [t] -> [t | Tree.rootLabel t /= lastInPath]+      _ -> ts++treeDeletePathWithLastBehavingAs :: forall a. Eq a => (a -> [Tree a] -> [Tree a]) -> NonEmpty a -> [Tree a] -> [Tree a]+treeDeletePathWithLastBehavingAs f slugs =+  go (toList slugs)+  where+    go :: [a] -> [Tree a] -> [Tree a]+    go [] t = t+    go [p] ts =+      f p ts+    go (p : ps) t =+      t <&> \node@(Node x xs) ->+        if x == p+          then Node x $ go ps xs+          else node++treeDeleteChild :: Eq a => a -> [Tree a] -> [Tree a]+treeDeleteChild x =+  List.deleteBy (\p q -> Tree.rootLabel p == Tree.rootLabel q) (Node x [])