packages feed

rosezipper 0.1 → 0.2

raw patch · 5 files changed

+220/−194 lines, 5 filesdep ~basesetup-changednew-uploader

Dependency ranges changed: base

Files

Data/Tree/Zipper.hs view
@@ -1,14 +1,18 @@ ----- Copyright (c) Krasimir Angelov 2008.--- Copyright (c) Iavor S. Diatchki 2008.+-- Copynext (c) Krasimir Angelov 2008.+-- Copynext (c) Iavor S. Diatchki 2008. -- -- Generic zipper implementation for Data.Tree -- --  module Data.Tree.Zipper-  ( TreeLoc(..)+  ( TreePos+  , PosType, Empty, Full +  -- * Context+  , before, after, forest, tree, label, parents+   -- * Conversions   , fromTree   , fromForest@@ -18,236 +22,284 @@   -- * Moving around   , parent   , root-  , getChild-  , findChild-  , firstChild-  , lastChild-  , left-  , right+  , prevSpace, prevTree, prev, first, spaceAt+  , nextSpace, nextTree, next, last+  , children, firstChild, lastChild, childAt    -- * Node classification   , isRoot   , isFirst   , isLast   , isLeaf-  , isChild+  , isContained   , hasChildren -  -- * Tree-specific mutation-  , insertLeft-  , insertRight-  , insertDownFirst-  , insertDownLast-  , insertDownAt-  , delete-   -- * Working with the current tree+  , insert+  , delete   , setTree   , modifyTree   , modifyLabel   , setLabel-  , getLabel   ) where  import Data.Tree+import Prelude hiding (last)  -- | A position within a 'Tree'.-data TreeLoc a  = Loc-  { tree    :: Tree a       -- ^ The currently selected tree.-  , lefts   :: Forest a     -- ^ Siblings on the left, closest first.-  , rights  :: Forest a     -- ^ Siblings on the right, closest first.-  , parents :: [(Forest a, a, Forest a)]-      -- ^ The contexts of the parents for this location.+-- The parameter 't' inidcates if the position is pointing to+-- a specific tree (if 't' is 'Full'), or if it is pointing in-between+-- trees (if 't' is 'Empty').+data TreePos t a  = Loc+  { _content   :: t a        -- ^ The currently selected tree.+  , _before    :: Forest a+  , _after     :: Forest a+  , _parents   :: [(Forest a, a, Forest a)]   } deriving (Read,Show,Eq)  +-- | Siblings before this position, closest first.+before         :: PosType t => TreePos t a -> Forest a+before          = _before++-- | Siblings after this position, closest first.+after          :: PosType t => TreePos t a -> Forest a+after           = _after++-- | The contexts of the parents for this position.+parents        :: PosType t => TreePos t a -> [(Forest a, a, Forest a)]+parents         = _parents++-- | Position which does not point to a tree (e.g., it is between two trees).+data Empty a    = E deriving (Read,Show,Eq)++-- | Position which points to a tree.+newtype Full a  = F { unF :: Tree a } deriving (Read,Show,Eq)+++-- | Positions may be either 'Full' or 'Empty'.+class PosType t where+  _prev      :: TreePos t a -> Maybe (TreePos t a)+  _next      :: TreePos t a -> Maybe (TreePos t a)+  _forest    :: TreePos t a -> Forest a+++instance PosType Full where+  _prev       = prevTree . prevSpace+  _next       = nextTree . nextSpace+  _forest loc = foldl (flip (:)) (tree loc : after loc) (before loc)++instance PosType Empty where+  _prev       = fmap prevSpace . prevTree+  _next       = fmap nextSpace . nextTree+  _forest loc = foldl (flip (:)) (after loc) (before loc)+++++-- XXX: We do this because haddock insist on placing methods+-- in the class...++-- | The sibling before this location.+prev    :: PosType t => TreePos t a -> Maybe (TreePos t a)+prev     = _prev++-- | The sibling after this location.+next     :: PosType t => TreePos t a -> Maybe (TreePos t a)+next      = _next++-- | All trees at this location+-- (i.e., the current tree---if any---and its siblings).+forest   :: PosType t => TreePos t a -> Forest a+forest    = _forest+++++ -- Moving around ---------------------------------------------------------------  -- | The parent of the given location.-parent :: TreeLoc a -> Maybe (TreeLoc a)+parent :: PosType t => TreePos t a -> Maybe (TreePos Full a) parent loc =   case parents loc of-    (pls,v,prs) : ps -> Just-      Loc { tree = Node v (combChildren (lefts loc) (tree loc) (rights loc))-          , lefts = pls, rights = prs, parents = ps+    (ls,a,rs) : ps -> Just+      Loc { _content  = F (Node a (forest loc))+          , _before   = ls+          , _after    = rs+          , _parents  = ps           }     [] -> Nothing   -- | The top-most parent of the given location.-root :: TreeLoc a -> TreeLoc a+root :: TreePos Full a -> TreePos Full a root loc = maybe loc root (parent loc) +-- | The space immediately before this location.+prevSpace :: TreePos Full a -> TreePos Empty a+prevSpace loc = loc { _content = E, _after = tree loc : after loc } --- | The left sibling of the given location.-left :: TreeLoc a -> Maybe (TreeLoc a)-left loc =-  case lefts loc of-    t : ts -> Just loc { tree = t, lefts = ts, rights = tree loc : rights loc }+-- | The tree before this location, if any.+prevTree :: TreePos Empty a -> Maybe (TreePos Full a)+prevTree loc =+  case before loc of+    t : ts -> Just loc { _content = F t, _before = ts }     []     -> Nothing --- | The right sibling of the given location.-right :: TreeLoc a -> Maybe (TreeLoc a)-right loc =-  case rights loc of-    t : ts -> Just loc { tree = t, lefts = tree loc : lefts loc, rights = ts }++-- | The space immediately after this location.+nextSpace :: TreePos Full a -> TreePos Empty a+nextSpace loc = loc { _content = E, _before = tree loc : before loc }+++-- | The tree after this location, if any.+nextTree :: TreePos Empty a -> Maybe (TreePos Full a)+nextTree loc =+  case after loc of+    t : ts -> Just loc { _content = F t, _after = ts }     []     -> Nothing  --- | The first child of the given location.-firstChild :: TreeLoc a -> Maybe (TreeLoc a)-firstChild loc =-  case subForest (tree loc) of-    t : ts -> Just-      Loc { tree = t, lefts = [], rights = ts , parents = downParents loc }-    [] -> Nothing+-- | The location at the beginning of the forest of children.+children :: TreePos Full a -> TreePos Empty a+children loc =+  Loc { _content  = E+      , _before   = []+      , _after    = subForest (tree loc)+      , _parents  = (before loc, rootLabel (tree loc), after loc)+                  : parents loc+      } --- | The last child of the given location.-lastChild :: TreeLoc a -> Maybe (TreeLoc a)-lastChild loc =-  case reverse (subForest (tree loc)) of-    t : ts -> Just-      Loc { tree = t, lefts = ts, rights = [], parents = downParents loc }-    [] -> Nothing+-- | The first space in the current forest.+first :: TreePos Empty a -> TreePos Empty a+first loc = loc { _content  = E+                , _before   = []+                , _after    = reverse (before loc) ++ after loc+                } --- | The child with the given index (starting from 0).-getChild :: Int -> TreeLoc a -> Maybe (TreeLoc a)-getChild n loc =-  do (t:ls,rs) <- splitChildren [] (subForest (tree loc)) n-     return Loc { tree = t, lefts = ls, rights = rs, parents = downParents loc }+-- | The last space in the current forest.+last :: TreePos Empty a -> TreePos Empty a+last loc = loc { _content = E+               , _before  = reverse (after loc) ++ before loc+               , _after   = []+               } --- | The first child that satisfies a predicate.-findChild :: (Tree a -> Bool) -> TreeLoc a -> Maybe (TreeLoc a)-findChild p loc =-  do (ls,t,rs) <- split [] (subForest (tree loc))-     return Loc { tree = t, lefts = ls, rights = rs, parents = downParents loc }+-- | The empty space at the given index.  The first space is at index 0.+-- For indexes that are negative or too large, we return the first and last+-- position in the tree, respectively.+spaceAt :: Int -> TreePos Empty a -> TreePos Empty a+spaceAt n loc = loc { _content = E+                    , _before  = reverse as+                    , _after   = bs+                    }+  where (as,bs) = splitAt n (forest loc) -  where split acc (x:xs) | p x  = Just (acc,x,xs)-        split acc (x:xs)        = split (x:acc) xs-        split _ []              = Nothing --- private: computes the parent for "down" operations.-downParents :: TreeLoc a -> [(Forest a, a, Forest a)]-downParents loc = (lefts loc, rootLabel (tree loc), rights loc) : parents loc+-- | The first child of the given location.+firstChild :: TreePos Full a -> Maybe (TreePos Full a)+firstChild = nextTree . children +-- | The last child of the given location.+lastChild :: TreePos Full a -> Maybe (TreePos Full a)+lastChild = prevTree . last . children +-- | The child at the given index in the tree.+-- The first child is at index 0.+childAt :: Int -> TreePos Full a -> Maybe (TreePos Full a)+childAt n | n < 0 = const Nothing+childAt n         = nextTree . spaceAt n . children + -- Conversions -----------------------------------------------------------------  -- | A location corresponding to the root of the given tree.-fromTree :: Tree a -> TreeLoc a-fromTree t = Loc { tree = t, lefts = [], rights = [], parents = [] }+fromTree :: Tree a -> TreePos Full a+fromTree t = Loc { _content = F t, _before = [], _after = [], _parents = [] } --- | The location of the first tree in a forest.-fromForest :: Forest a -> Maybe (TreeLoc a)-fromForest (t:ts) = Just Loc { tree = t, lefts = [], rights = ts, parents = [] }-fromForest []     = Nothing+-- | The location at the beginning of the forest.+fromForest :: Forest a -> TreePos Empty a+fromForest ts = Loc { _content = E, _before = [], _after = ts, _parents = [] } --- | Computes the tree containing this location.-toTree :: TreeLoc a -> Tree a+-- | The tree containing this location.+toTree :: TreePos Full a -> Tree a toTree loc = tree (root loc) --- | Computes the forest containing this location.-toForest :: TreeLoc a -> Forest a-toForest loc = let r = root loc in combChildren (lefts r) (tree r) (rights r)+-- | The forest containing this location.+toForest :: PosType t => TreePos t a -> Forest a+toForest loc = case parent loc of+                 Nothing -> forest loc+                 Just p  -> toForest p -- polymprphic recursion   -- Queries ---------------------------------------------------------------------  -- | Are we at the top of the tree?-isRoot :: TreeLoc a -> Bool+isRoot :: PosType t => TreePos t a -> Bool isRoot loc = null (parents loc) --- | Are we at the left end of the the tree?-isFirst :: TreeLoc a -> Bool-isFirst loc = null (lefts loc)+-- | Are we the first position (of its kind) in a forest.+isFirst :: PosType t => TreePos t a -> Bool+isFirst loc = null (before loc) --- | Are we at the right end of the tree?-isLast :: TreeLoc a -> Bool-isLast loc = null (rights loc)+-- | Are we the last position (of its kind) in a forest.+isLast :: PosType t => TreePos t a -> Bool+isLast loc = null (after loc)  -- | Are we at the bottom of the tree?-isLeaf :: TreeLoc a -> Bool+isLeaf :: TreePos Full a -> Bool isLeaf loc = null (subForest (tree loc))  -- | Do we have a parent?-isChild :: TreeLoc a -> Bool-isChild loc = not (isRoot loc)+isContained :: PosType t => TreePos t a -> Bool+isContained loc = not (isRoot loc)  -- | Do we have children?-hasChildren :: TreeLoc a -> Bool+hasChildren :: TreePos Full a -> Bool hasChildren loc = not (isLeaf loc)   -- The current tree -----------------------------------------------------------  +-- | The selected tree.+tree :: TreePos Full a -> Tree a+tree x = unF (_content x)++-- | The current label.+label :: TreePos Full a -> a+label loc = rootLabel (tree loc)++-- | Insert a new tree at the current position.+insert :: Tree a -> TreePos Empty a -> TreePos Full a+insert t loc = loc { _content = F t }++-- | Remove the tree at the current position.+delete :: TreePos Full a -> TreePos Empty a+delete loc = loc { _content = E }+++ -- | Change the current tree.-setTree :: Tree a -> TreeLoc a -> TreeLoc a-setTree t loc = loc { tree = t }+setTree :: Tree a -> TreePos Full a -> TreePos Full a+setTree t loc = loc { _content = F t }  -- | Modify the current tree.-modifyTree :: (Tree a -> Tree a) -> TreeLoc a -> TreeLoc a+modifyTree :: (Tree a -> Tree a) -> TreePos Full a -> TreePos Full a modifyTree f loc = setTree (f (tree loc)) loc  -- | Modify the label at the current node.-modifyLabel :: (a -> a) -> TreeLoc a -> TreeLoc a-modifyLabel f loc = setLabel (f (getLabel loc)) loc+modifyLabel :: (a -> a) -> TreePos Full a -> TreePos Full a+modifyLabel f loc = setLabel (f (label loc)) loc  -- | Change the label at the current node.-setLabel :: a -> TreeLoc a -> TreeLoc a+setLabel :: a -> TreePos Full a -> TreePos Full a setLabel v loc = modifyTree (\t -> t { rootLabel = v }) loc --- Get the current label.-getLabel :: TreeLoc a -> a-getLabel loc = rootLabel (tree loc) - -------------------------------------------------------------------------------- --- | Insert a tree to the left of the current position.--- The new tree becomes the current tree.-insertLeft :: Tree a -> TreeLoc a -> TreeLoc a-insertLeft t loc = loc { tree = t, rights = tree loc : rights loc } --- | Insert a tree to the right of the current position.--- The new tree becomes the current tree.-insertRight :: Tree a -> TreeLoc a -> TreeLoc a-insertRight t loc = loc { tree = t, lefts = tree loc : lefts loc } -insertDownFirst :: Tree a -> TreeLoc a -> TreeLoc a-insertDownFirst t loc =-  loc { tree = t, lefts = [], rights = subForest (tree loc)-      , parents = downParents loc } -insertDownLast :: Tree a -> TreeLoc a -> TreeLoc a-insertDownLast t loc =-  loc { tree = t, lefts = reverse (subForest (tree loc)), rights = []-      , parents = downParents loc } -insertDownAt :: Int -> Tree a -> TreeLoc a -> Maybe (TreeLoc a)-insertDownAt n t loc =-  do (ls,rs) <- splitChildren [] (subForest (tree loc)) n-     return loc { tree = t, lefts = ls, rights = rs, parents = downParents loc }---- | Delete the current node.  The new position is:---   * the right sibling, or if none---   * the left sibling, or if none---   * the parent.-delete :: TreeLoc a -> Maybe (TreeLoc a)-delete loc =-  case rights loc of-    t : ts -> Just loc { tree = t, rights = ts }-    _ -> case lefts loc of-           t : ts -> Just loc { tree = t, lefts = ts }-           _ -> do loc1 <- parent loc-                   return $ modifyTree (\t -> t { subForest = [] }) loc1---splitChildren :: [a] -> [a] -> Int -> Maybe ([a],[a])-splitChildren acc xs 0      = Just (acc,xs)-splitChildren acc (x:xs) n  = splitChildren (x:acc) xs $! n-1-splitChildren _ _ _         = Nothing---combChildren ls t rs = foldl (flip (:)) (t:rs) ls
LICENSE view
@@ -1,27 +1,8 @@-Copyright (c) Krasimir Angelov 2008.-Copyright (c) Iavor S. Diatchki 2008.-All rights reserved.+Copyright (c) 2008 Krasimir Angelov+Copyright (c) 2008 Iavor S. Diatchki -Redistribution and use in source and binary forms, with or without-modification, are permitted provided that the following conditions-are met:-1. Redistributions of source code must retain the above copyright-   notice, this list of conditions and the following disclaimer.-2. Redistributions in binary form must reproduce the above copyright-   notice, this list of conditions and the following disclaimer in the-   documentation and/or other materials provided with the distribution.-3. Neither the name of the author nor the names of his contributors-   may be used to endorse or promote products derived from this software-   without specific prior written permission.+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: -THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND-ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE-IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE-ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE-FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL-DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS-OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)-HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT-LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY-OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF-SUCH DAMAGE.+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.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
− Setup.lhs 
@@ -1,3 +0,0 @@-#!/usr/bin/env runhaskell-> import Distribution.Simple-> main = defaultMain
rosezipper.cabal view
@@ -1,23 +1,16 @@-name:                rosezipper-version:             0.1-synopsis:            Generic zipper implementation for Data.Tree-description:         Generic zipper implementation for Data.Tree-category:            Data-license:             BSD3-license-file:        LICENSE-author:              Krasimir Angelov and Iavor S. Diatchki-maintainer:          Eric Kow <E.Y.Kow@brighton.ac.uk>-build-Depends:       base >= 3, containers-build-type:          Simple--cabal-version:       >=1.2--Flag splitBase-  description: Choose the new smaller, split-up base package.+Name:           rosezipper+Version:        0.2+License:        BSD3+License-file:   LICENSE+Author:         Krasimir Angelov, Iavor S. Diatchki+Maintainer:     Iavor S. Diatchki <iavor.diatchki@gmail.com>+Category:       Data Structures+Synopsis:       Generic zipper implementation for Data.Tree+Description:    A Haskell datastructure for working with locations in+                trees or forests.+Build-Depends:  base < 5, containers+Build-type:     Simple+Extra-source-files: LICENSE+Exposed-modules: Data.Tree.Zipper+GHC-options:    -O2 -Wall -Library-  Exposed-modules:     Data.Tree.Zipper-  if flag(splitBase)-    Build-depends: base >= 3, containers-  else-    Build-Depends: base < 3