-- ------------------------------------------------------------

{- |
   Module     : 
   Copyright  : Copyright (C) 2011 Uwe Schmidt
   License    : MIT

   Maintainer : Uwe Schmidt (uwe\@fh-wedel.de)
   Stability  : experimental
   Portability: portable

   Space and time efficient editing of rose trees
-}

-- ------------------------------------------------------------

module Data.Tree.NTree.Edit
where

import Data.Maybe

import Data.Tree.NTree.TypeDefs

-- import           Debug.Trace


-- | editNTreeBottomUp is a space optimized tree edit function
--
-- The nodes in a tree are visited bottom up. An edit function is applied to
-- all nodes. A Nothing result of the editing function indicates no changes.
-- This is used to share the input tree within the resulting tree.
--
-- The following law holds:
--
-- > editNTreeBottomUp (const Nothing) t == [t]
--
-- In this case the resulting tree does not only represent the same value
-- but it is the same machine value (relative to some evaluations of closures
-- during the tree walk
--
-- With a simple fold like editing function the whole tree would be reconstructed
-- in memory

editNTreeBottomUp               :: (NTree a -> Maybe [NTree a]) -> NTree a -> [NTree a]
editNTreeBottomUp :: (NTree a -> Maybe [NTree a]) -> NTree a -> [NTree a]
editNTreeBottomUp NTree a -> Maybe [NTree a]
f NTree a
t0          = [NTree a]
-> ([NTree a] -> [NTree a]) -> Maybe [NTree a] -> [NTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [NTree a
t0] [NTree a] -> [NTree a]
forall a. a -> a
id (Maybe [NTree a] -> [NTree a])
-> (NTree a -> Maybe [NTree a]) -> NTree a -> [NTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree a -> Maybe [NTree a]
editNTreeBU (NTree a -> [NTree a]) -> NTree a -> [NTree a]
forall a b. (a -> b) -> a -> b
$ NTree a
t0
    where

 -- editNTreeBU                 :: NTree a -> Maybe [NTree a]
    editNTreeBU :: NTree a -> Maybe [NTree a]
editNTreeBU t :: NTree a
t@(NTree a
n [NTree a]
cs)
        | Maybe [NTree a] -> Bool
forall a. Maybe a -> Bool
isNothing Maybe [NTree a]
r'
          Bool -> Bool -> Bool
&&
          Maybe [NTree a] -> Bool
forall a. Maybe a -> Bool
isJust Maybe [NTree a]
cl'            = [NTree a] -> Maybe [NTree a]
forall a. a -> Maybe a
Just [NTree a
t']                     -- children have been change but not the node itself
        | Bool
otherwise             = Maybe [NTree a]
r'                            -- nothing has been changes or node has been changed 
        where
        cl' :: Maybe [NTree a]
cl'                     = [NTree a] -> Maybe [NTree a]
editNTreesBU [NTree a]
cs               -- the edited children
        t' :: NTree a
t'                      = case Maybe [NTree a]
cl' of                   -- the node to be processed with f
                                  Maybe [NTree a]
Nothing       -> NTree a
t            -- possibly with the new children (bottom up)
                                  Just cs'      -> a -> [NTree a] -> NTree a
forall a. a -> NTrees a -> NTree a
NTree a
n [NTree a]
cs'
        r' :: Maybe [NTree a]
r'                      = NTree a -> Maybe [NTree a]
f NTree a
t'                          -- the edited result

 -- editNTreesBU                :: [NTree a] -> Maybe [NTree a]
    editNTreesBU :: [NTree a] -> Maybe [NTree a]
editNTreesBU []             = Maybe [NTree a]
forall a. Maybe a
Nothing
    editNTreesBU (NTree a
t : [NTree a]
ts)       = Maybe [NTree a] -> Maybe [NTree a] -> Maybe [NTree a]
mergeRes
                                  (NTree a -> Maybe [NTree a]
editNTreeBU  NTree a
t )
                                  ([NTree a] -> Maybe [NTree a]
editNTreesBU [NTree a]
ts)
        where
        mergeRes :: Maybe [NTree a] -> Maybe [NTree a] -> Maybe [NTree a]
mergeRes Maybe [NTree a]
r'             = case Maybe [NTree a]
r' of
                                  Maybe [NTree a]
Nothing       -> Maybe [NTree a]
-> ([NTree a] -> Maybe [NTree a])
-> Maybe [NTree a]
-> Maybe [NTree a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe [NTree a]
forall a. Maybe a
Nothing ([NTree a] -> Maybe [NTree a]
forall a. a -> Maybe a
Just ([NTree a] -> Maybe [NTree a])
-> ([NTree a] -> [NTree a]) -> [NTree a] -> Maybe [NTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree a
t NTree a -> [NTree a] -> [NTree a]
forall a. a -> [a] -> [a]
:))
                                  Just [NTree a]
ts'      -> [NTree a] -> Maybe [NTree a]
forall a. a -> Maybe a
Just ([NTree a] -> Maybe [NTree a])
-> (Maybe [NTree a] -> [NTree a])
-> Maybe [NTree a]
-> Maybe [NTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([NTree a]
ts' [NTree a] -> [NTree a] -> [NTree a]
forall a. [a] -> [a] -> [a]
++) ([NTree a] -> [NTree a])
-> (Maybe [NTree a] -> [NTree a]) -> Maybe [NTree a] -> [NTree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NTree a] -> Maybe [NTree a] -> [NTree a]
forall a. a -> Maybe a -> a
fromMaybe [NTree a]
ts


-- | A space optimized map for NTrees
--
-- Subtrees, that are not changed are reused in the resulting tree
-- See also: editNTreeBottomUp

mapNTree'                       :: (a -> Maybe a) -> NTree a -> NTree a
mapNTree' :: (a -> Maybe a) -> NTree a -> NTree a
mapNTree' a -> Maybe a
f NTree a
t0                  = NTree a -> (NTree a -> NTree a) -> Maybe (NTree a) -> NTree a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe NTree a
t0 NTree a -> NTree a
forall a. a -> a
id (Maybe (NTree a) -> NTree a)
-> (NTree a -> Maybe (NTree a)) -> NTree a -> NTree a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTree a -> Maybe (NTree a)
map' (NTree a -> NTree a) -> NTree a -> NTree a
forall a b. (a -> b) -> a -> b
$ NTree a
t0
    where

    -- map'                     :: NTree a -> Maybe (NTree a)
    map' :: NTree a -> Maybe (NTree a)
map' (NTree a
n NTrees a
cs)           = Maybe a -> Maybe (NTrees a) -> Maybe (NTree a)
mergeRes (a -> Maybe a
f a
n) (NTrees a -> Maybe (NTrees a)
maps' NTrees a
cs)
        where
        mergeRes :: Maybe a -> Maybe (NTrees a) -> Maybe (NTree a)
mergeRes Maybe a
Nothing Maybe (NTrees a)
Nothing        = Maybe (NTree a)
forall a. Maybe a
Nothing
        mergeRes Maybe a
Nothing (Just NTrees a
cs')     = NTree a -> Maybe (NTree a)
forall a. a -> Maybe a
Just (a -> NTrees a -> NTree a
forall a. a -> NTrees a -> NTree a
NTree a
n             NTrees a
cs')
        mergeRes (Just a
n') Maybe (NTrees a)
cl           = NTree a -> Maybe (NTree a)
forall a. a -> Maybe a
Just (a -> NTrees a -> NTree a
forall a. a -> NTrees a -> NTree a
NTree a
n' (NTrees a -> Maybe (NTrees a) -> NTrees a
forall a. a -> Maybe a -> a
fromMaybe NTrees a
cs Maybe (NTrees a)
cl))

    -- maps'                    :: [NTree a] -> Maybe [NTree a]
    maps' :: NTrees a -> Maybe (NTrees a)
maps' []                    = Maybe (NTrees a)
forall a. Maybe a
Nothing
    maps' (NTree a
t : NTrees a
ts)              = Maybe (NTree a) -> Maybe (NTrees a) -> Maybe (NTrees a)
mergeRes
                                  (NTree a -> Maybe (NTree a)
map'  NTree a
t )
                                  (NTrees a -> Maybe (NTrees a)
maps' NTrees a
ts)
        where
        mergeRes :: Maybe (NTree a) -> Maybe (NTrees a) -> Maybe (NTrees a)
mergeRes Maybe (NTree a)
r'             = case Maybe (NTree a)
r' of
                                  Maybe (NTree a)
Nothing       -> Maybe (NTrees a)
-> (NTrees a -> Maybe (NTrees a))
-> Maybe (NTrees a)
-> Maybe (NTrees a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Maybe (NTrees a)
forall a. Maybe a
Nothing (NTrees a -> Maybe (NTrees a)
forall a. a -> Maybe a
Just (NTrees a -> Maybe (NTrees a))
-> (NTrees a -> NTrees a) -> NTrees a -> Maybe (NTrees a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree a
t NTree a -> NTrees a -> NTrees a
forall a. a -> [a] -> [a]
:))
                                  Just NTree a
t'       -> NTrees a -> Maybe (NTrees a)
forall a. a -> Maybe a
Just (NTrees a -> Maybe (NTrees a))
-> (Maybe (NTrees a) -> NTrees a)
-> Maybe (NTrees a)
-> Maybe (NTrees a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NTree a
t' NTree a -> NTrees a -> NTrees a
forall a. a -> [a] -> [a]
:) (NTrees a -> NTrees a)
-> (Maybe (NTrees a) -> NTrees a) -> Maybe (NTrees a) -> NTrees a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NTrees a -> Maybe (NTrees a) -> NTrees a
forall a. a -> Maybe a -> a
fromMaybe NTrees a
ts

-- eof ------------------------------------------------------------