--
-- Copynext (c) Krasimir Angelov 2008.
-- Copynext (c) Iavor S. Diatchki 2008.
--
-- Generic zipper implementation for Data.Tree
--
--

module Data.Tree.Zipper
  ( TreePos
  , PosType, Empty, Full

  -- * Context
  , before, after, forest, tree, label, parents

  -- * Conversions
  , fromTree
  , fromForest
  , toForest
  , toTree

  -- * Moving around
  , parent
  , root
  , prevSpace, prevTree, prev, first, spaceAt
  , nextSpace, nextTree, next, last
  , children, firstChild, lastChild, childAt

  -- * Node classification
  , isRoot
  , isFirst
  , isLast
  , isLeaf
  , isContained
  , hasChildren

  -- * Working with the current tree
  , insert
  , delete
  , setTree
  , modifyTree
  , modifyLabel
  , setLabel
  ) where

import Data.Tree
import Prelude hiding (last)

-- | A position within a 'Tree'.
-- 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
  { forall (t :: * -> *) a. TreePos t a -> t a
_content   :: t a        -- ^ The currently selected tree.
  , forall (t :: * -> *) a. TreePos t a -> Forest a
_before    :: Forest a
  , forall (t :: * -> *) a. TreePos t a -> Forest a
_after     :: Forest a
  , forall (t :: * -> *) a. TreePos t a -> [(Forest a, a, Forest a)]
_parents   :: [(Forest a, a, Forest a)]
  } deriving (ReadPrec [TreePos t a]
ReadPrec (TreePos t a)
Int -> ReadS (TreePos t a)
ReadS [TreePos t a]
(Int -> ReadS (TreePos t a))
-> ReadS [TreePos t a]
-> ReadPrec (TreePos t a)
-> ReadPrec [TreePos t a]
-> Read (TreePos t a)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall (t :: * -> *) a.
(Read a, Read (t a)) =>
ReadPrec [TreePos t a]
forall (t :: * -> *) a.
(Read a, Read (t a)) =>
ReadPrec (TreePos t a)
forall (t :: * -> *) a.
(Read a, Read (t a)) =>
Int -> ReadS (TreePos t a)
forall (t :: * -> *) a. (Read a, Read (t a)) => ReadS [TreePos t a]
$creadsPrec :: forall (t :: * -> *) a.
(Read a, Read (t a)) =>
Int -> ReadS (TreePos t a)
readsPrec :: Int -> ReadS (TreePos t a)
$creadList :: forall (t :: * -> *) a. (Read a, Read (t a)) => ReadS [TreePos t a]
readList :: ReadS [TreePos t a]
$creadPrec :: forall (t :: * -> *) a.
(Read a, Read (t a)) =>
ReadPrec (TreePos t a)
readPrec :: ReadPrec (TreePos t a)
$creadListPrec :: forall (t :: * -> *) a.
(Read a, Read (t a)) =>
ReadPrec [TreePos t a]
readListPrec :: ReadPrec [TreePos t a]
Read,Int -> TreePos t a -> ShowS
[TreePos t a] -> ShowS
TreePos t a -> String
(Int -> TreePos t a -> ShowS)
-> (TreePos t a -> String)
-> ([TreePos t a] -> ShowS)
-> Show (TreePos t a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (t :: * -> *) a.
(Show a, Show (t a)) =>
Int -> TreePos t a -> ShowS
forall (t :: * -> *) a.
(Show a, Show (t a)) =>
[TreePos t a] -> ShowS
forall (t :: * -> *) a.
(Show a, Show (t a)) =>
TreePos t a -> String
$cshowsPrec :: forall (t :: * -> *) a.
(Show a, Show (t a)) =>
Int -> TreePos t a -> ShowS
showsPrec :: Int -> TreePos t a -> ShowS
$cshow :: forall (t :: * -> *) a.
(Show a, Show (t a)) =>
TreePos t a -> String
show :: TreePos t a -> String
$cshowList :: forall (t :: * -> *) a.
(Show a, Show (t a)) =>
[TreePos t a] -> ShowS
showList :: [TreePos t a] -> ShowS
Show,TreePos t a -> TreePos t a -> Bool
(TreePos t a -> TreePos t a -> Bool)
-> (TreePos t a -> TreePos t a -> Bool) -> Eq (TreePos t a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (t :: * -> *) a.
(Eq a, Eq (t a)) =>
TreePos t a -> TreePos t a -> Bool
$c== :: forall (t :: * -> *) a.
(Eq a, Eq (t a)) =>
TreePos t a -> TreePos t a -> Bool
== :: TreePos t a -> TreePos t a -> Bool
$c/= :: forall (t :: * -> *) a.
(Eq a, Eq (t a)) =>
TreePos t a -> TreePos t a -> Bool
/= :: TreePos t a -> TreePos t a -> Bool
Eq)


-- | Siblings before this position, closest first.
before         :: PosType t => TreePos t a -> Forest a
before :: forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before          = TreePos t a -> Forest a
forall (t :: * -> *) a. TreePos t a -> Forest a
_before

-- | Siblings after this position, closest first.
after          :: PosType t => TreePos t a -> Forest a
after :: forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after           = TreePos t a -> Forest a
forall (t :: * -> *) a. TreePos t a -> Forest a
_after

-- | The contexts of the parents for this position.
parents        :: PosType t => TreePos t a -> [(Forest a, a, Forest a)]
parents :: forall (t :: * -> *) a.
PosType t =>
TreePos t a -> [(Forest a, a, Forest a)]
parents         = TreePos t a -> [(Forest a, a, Forest a)]
forall (t :: * -> *) a. TreePos t a -> [(Forest a, a, Forest a)]
_parents

-- | Position which does not point to a tree (e.g., it is between two trees).
data Empty a    = E deriving (ReadPrec [Empty a]
ReadPrec (Empty a)
Int -> ReadS (Empty a)
ReadS [Empty a]
(Int -> ReadS (Empty a))
-> ReadS [Empty a]
-> ReadPrec (Empty a)
-> ReadPrec [Empty a]
-> Read (Empty a)
forall a. ReadPrec [Empty a]
forall a. ReadPrec (Empty a)
forall a. Int -> ReadS (Empty a)
forall a. ReadS [Empty a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Int -> ReadS (Empty a)
readsPrec :: Int -> ReadS (Empty a)
$creadList :: forall a. ReadS [Empty a]
readList :: ReadS [Empty a]
$creadPrec :: forall a. ReadPrec (Empty a)
readPrec :: ReadPrec (Empty a)
$creadListPrec :: forall a. ReadPrec [Empty a]
readListPrec :: ReadPrec [Empty a]
Read,Int -> Empty a -> ShowS
[Empty a] -> ShowS
Empty a -> String
(Int -> Empty a -> ShowS)
-> (Empty a -> String) -> ([Empty a] -> ShowS) -> Show (Empty a)
forall a. Int -> Empty a -> ShowS
forall a. [Empty a] -> ShowS
forall a. Empty a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Empty a -> ShowS
showsPrec :: Int -> Empty a -> ShowS
$cshow :: forall a. Empty a -> String
show :: Empty a -> String
$cshowList :: forall a. [Empty a] -> ShowS
showList :: [Empty a] -> ShowS
Show,Empty a -> Empty a -> Bool
(Empty a -> Empty a -> Bool)
-> (Empty a -> Empty a -> Bool) -> Eq (Empty a)
forall a. Empty a -> Empty a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Empty a -> Empty a -> Bool
== :: Empty a -> Empty a -> Bool
$c/= :: forall a. Empty a -> Empty a -> Bool
/= :: Empty a -> Empty a -> Bool
Eq)

-- | Position which points to a tree.
newtype Full a  = F { forall a. Full a -> Tree a
unF :: Tree a } deriving (ReadPrec [Full a]
ReadPrec (Full a)
Int -> ReadS (Full a)
ReadS [Full a]
(Int -> ReadS (Full a))
-> ReadS [Full a]
-> ReadPrec (Full a)
-> ReadPrec [Full a]
-> Read (Full a)
forall a. Read a => ReadPrec [Full a]
forall a. Read a => ReadPrec (Full a)
forall a. Read a => Int -> ReadS (Full a)
forall a. Read a => ReadS [Full a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Full a)
readsPrec :: Int -> ReadS (Full a)
$creadList :: forall a. Read a => ReadS [Full a]
readList :: ReadS [Full a]
$creadPrec :: forall a. Read a => ReadPrec (Full a)
readPrec :: ReadPrec (Full a)
$creadListPrec :: forall a. Read a => ReadPrec [Full a]
readListPrec :: ReadPrec [Full a]
Read,Int -> Full a -> ShowS
[Full a] -> ShowS
Full a -> String
(Int -> Full a -> ShowS)
-> (Full a -> String) -> ([Full a] -> ShowS) -> Show (Full a)
forall a. Show a => Int -> Full a -> ShowS
forall a. Show a => [Full a] -> ShowS
forall a. Show a => Full a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Full a -> ShowS
showsPrec :: Int -> Full a -> ShowS
$cshow :: forall a. Show a => Full a -> String
show :: Full a -> String
$cshowList :: forall a. Show a => [Full a] -> ShowS
showList :: [Full a] -> ShowS
Show,Full a -> Full a -> Bool
(Full a -> Full a -> Bool)
-> (Full a -> Full a -> Bool) -> Eq (Full a)
forall a. Eq a => Full a -> Full a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Full a -> Full a -> Bool
== :: Full a -> Full a -> Bool
$c/= :: forall a. Eq a => Full a -> Full a -> Bool
/= :: Full a -> Full a -> Bool
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 :: forall a. TreePos Full a -> Maybe (TreePos Full a)
_prev       = TreePos Empty a -> Maybe (TreePos Full a)
forall a. TreePos Empty a -> Maybe (TreePos Full a)
prevTree (TreePos Empty a -> Maybe (TreePos Full a))
-> (TreePos Full a -> TreePos Empty a)
-> TreePos Full a
-> Maybe (TreePos Full a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
prevSpace
  _next :: forall a. TreePos Full a -> Maybe (TreePos Full a)
_next       = TreePos Empty a -> Maybe (TreePos Full a)
forall a. TreePos Empty a -> Maybe (TreePos Full a)
nextTree (TreePos Empty a -> Maybe (TreePos Full a))
-> (TreePos Full a -> TreePos Empty a)
-> TreePos Full a
-> Maybe (TreePos Full a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
nextSpace
  _forest :: forall a. TreePos Full a -> Forest a
_forest TreePos Full a
loc = (Forest a -> Tree a -> Forest a)
-> Forest a -> Forest a -> Forest a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Tree a -> Forest a -> Forest a) -> Forest a -> Tree a -> Forest a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) (TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: TreePos Full a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos Full a
loc) (TreePos Full a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos Full a
loc)

instance PosType Empty where
  _prev :: forall a. TreePos Empty a -> Maybe (TreePos Empty a)
_prev       = (TreePos Full a -> TreePos Empty a)
-> Maybe (TreePos Full a) -> Maybe (TreePos Empty a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
prevSpace (Maybe (TreePos Full a) -> Maybe (TreePos Empty a))
-> (TreePos Empty a -> Maybe (TreePos Full a))
-> TreePos Empty a
-> Maybe (TreePos Empty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Empty a -> Maybe (TreePos Full a)
forall a. TreePos Empty a -> Maybe (TreePos Full a)
prevTree
  _next :: forall a. TreePos Empty a -> Maybe (TreePos Empty a)
_next       = (TreePos Full a -> TreePos Empty a)
-> Maybe (TreePos Full a) -> Maybe (TreePos Empty a)
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
nextSpace (Maybe (TreePos Full a) -> Maybe (TreePos Empty a))
-> (TreePos Empty a -> Maybe (TreePos Full a))
-> TreePos Empty a
-> Maybe (TreePos Empty a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Empty a -> Maybe (TreePos Full a)
forall a. TreePos Empty a -> Maybe (TreePos Full a)
nextTree
  _forest :: forall a. TreePos Empty a -> Forest a
_forest TreePos Empty a
loc = (Forest a -> Tree a -> Forest a)
-> Forest a -> Forest a -> Forest a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ((Tree a -> Forest a -> Forest a) -> Forest a -> Tree a -> Forest a
forall a b c. (a -> b -> c) -> b -> a -> c
flip (:)) (TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos Empty a
loc) (TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos Empty a
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 :: forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos t a)
prev     = TreePos t a -> Maybe (TreePos t a)
forall a. TreePos t a -> Maybe (TreePos t a)
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos t a)
_prev

-- | The sibling after this location.
next     :: PosType t => TreePos t a -> Maybe (TreePos t a)
next :: forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos t a)
next      = TreePos t a -> Maybe (TreePos t a)
forall a. TreePos t a -> Maybe (TreePos t a)
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos t a)
_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 :: forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
forest    = TreePos t a -> Forest a
forall a. TreePos t a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
_forest





-- Moving around ---------------------------------------------------------------

-- | The parent of the given location.
parent :: PosType t => TreePos t a -> Maybe (TreePos Full a)
parent :: forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
parent TreePos t a
loc =
  case TreePos t a -> [(Forest a, a, Forest a)]
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> [(Forest a, a, Forest a)]
parents TreePos t a
loc of
    (Forest a
ls,a
a,Forest a
rs) : [(Forest a, a, Forest a)]
ps -> TreePos Full a -> Maybe (TreePos Full a)
forall a. a -> Maybe a
Just
      Loc { _content :: Full a
_content  = Tree a -> Full a
forall a. Tree a -> Full a
F (a -> Forest a -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a (TreePos t a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
forest TreePos t a
loc))
          , _before :: Forest a
_before   = Forest a
ls
          , _after :: Forest a
_after    = Forest a
rs
          , _parents :: [(Forest a, a, Forest a)]
_parents  = [(Forest a, a, Forest a)]
ps
          }
    [] -> Maybe (TreePos Full a)
forall a. Maybe a
Nothing


-- | The top-most parent of the given location.
root :: TreePos Full a -> TreePos Full a
root :: forall a. TreePos Full a -> TreePos Full a
root TreePos Full a
loc = TreePos Full a
-> (TreePos Full a -> TreePos Full a)
-> Maybe (TreePos Full a)
-> TreePos Full a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TreePos Full a
loc TreePos Full a -> TreePos Full a
forall a. TreePos Full a -> TreePos Full a
root (TreePos Full a -> Maybe (TreePos Full a)
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
parent TreePos Full a
loc)

-- | The space immediately before this location.
prevSpace :: TreePos Full a -> TreePos Empty a
prevSpace :: forall a. TreePos Full a -> TreePos Empty a
prevSpace TreePos Full a
loc = TreePos Full a
loc { _content :: Empty a
_content = Empty a
forall a. Empty a
E, _after :: Forest a
_after = TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: TreePos Full a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos Full a
loc }

-- | The tree before this location, if any.
prevTree :: TreePos Empty a -> Maybe (TreePos Full a)
prevTree :: forall a. TreePos Empty a -> Maybe (TreePos Full a)
prevTree TreePos Empty a
loc =
  case TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos Empty a
loc of
    Tree a
t : Forest a
ts -> TreePos Full a -> Maybe (TreePos Full a)
forall a. a -> Maybe a
Just TreePos Empty a
loc { _content :: Full a
_content = Tree a -> Full a
forall a. Tree a -> Full a
F Tree a
t, _before :: Forest a
_before = Forest a
ts }
    []     -> Maybe (TreePos Full a)
forall a. Maybe a
Nothing


-- | The space immediately after this location.
nextSpace :: TreePos Full a -> TreePos Empty a
nextSpace :: forall a. TreePos Full a -> TreePos Empty a
nextSpace TreePos Full a
loc = TreePos Full a
loc { _content :: Empty a
_content = Empty a
forall a. Empty a
E, _before :: Forest a
_before = TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: TreePos Full a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos Full a
loc }


-- | The tree after this location, if any.
nextTree :: TreePos Empty a -> Maybe (TreePos Full a)
nextTree :: forall a. TreePos Empty a -> Maybe (TreePos Full a)
nextTree TreePos Empty a
loc =
  case TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos Empty a
loc of
    Tree a
t : Forest a
ts -> TreePos Full a -> Maybe (TreePos Full a)
forall a. a -> Maybe a
Just TreePos Empty a
loc { _content :: Full a
_content = Tree a -> Full a
forall a. Tree a -> Full a
F Tree a
t, _after :: Forest a
_after = Forest a
ts }
    []     -> Maybe (TreePos Full a)
forall a. Maybe a
Nothing


-- | The location at the beginning of the forest of children.
children :: TreePos Full a -> TreePos Empty a
children :: forall a. TreePos Full a -> TreePos Empty a
children TreePos Full a
loc =
  Loc { _content :: Empty a
_content  = Empty a
forall a. Empty a
E
      , _before :: Forest a
_before   = []
      , _after :: Forest a
_after    = Tree a -> Forest a
forall a. Tree a -> [Tree a]
subForest (TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc)
      , _parents :: [(Forest a, a, Forest a)]
_parents  = (TreePos Full a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos Full a
loc, Tree a -> a
forall a. Tree a -> a
rootLabel (TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc), TreePos Full a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos Full a
loc)
                  (Forest a, a, Forest a)
-> [(Forest a, a, Forest a)] -> [(Forest a, a, Forest a)]
forall a. a -> [a] -> [a]
: TreePos Full a -> [(Forest a, a, Forest a)]
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> [(Forest a, a, Forest a)]
parents TreePos Full a
loc
      }

-- | The first space in the current forest.
first :: TreePos Empty a -> TreePos Empty a
first :: forall a. TreePos Empty a -> TreePos Empty a
first TreePos Empty a
loc = TreePos Empty a
loc { _content :: Empty a
_content  = Empty a
forall a. Empty a
E
                , _before :: Forest a
_before   = []
                , _after :: Forest a
_after    = Forest a -> Forest a
forall a. [a] -> [a]
reverse (TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos Empty a
loc) Forest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++ TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos Empty a
loc
                }

-- | The last space in the current forest.
last :: TreePos Empty a -> TreePos Empty a
last :: forall a. TreePos Empty a -> TreePos Empty a
last TreePos Empty a
loc = TreePos Empty a
loc { _content :: Empty a
_content = Empty a
forall a. Empty a
E
               , _before :: Forest a
_before  = Forest a -> Forest a
forall a. [a] -> [a]
reverse (TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos Empty a
loc) Forest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++ TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos Empty a
loc
               , _after :: Forest a
_after   = []
               }

-- | 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 :: forall a. Int -> TreePos Empty a -> TreePos Empty a
spaceAt Int
n TreePos Empty a
loc = TreePos Empty a
loc { _content :: Empty a
_content = Empty a
forall a. Empty a
E
                    , _before :: Forest a
_before  = Forest a -> Forest a
forall a. [a] -> [a]
reverse Forest a
as
                    , _after :: Forest a
_after   = Forest a
bs
                    }
  where (Forest a
as,Forest a
bs) = Int -> Forest a -> (Forest a, Forest a)
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n (TreePos Empty a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
forest TreePos Empty a
loc)


-- | The first child of the given location.
firstChild :: TreePos Full a -> Maybe (TreePos Full a)
firstChild :: forall a. TreePos Full a -> Maybe (TreePos Full a)
firstChild = TreePos Empty a -> Maybe (TreePos Full a)
forall a. TreePos Empty a -> Maybe (TreePos Full a)
nextTree (TreePos Empty a -> Maybe (TreePos Full a))
-> (TreePos Full a -> TreePos Empty a)
-> TreePos Full a
-> Maybe (TreePos Full a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
children

-- | The last child of the given location.
lastChild :: TreePos Full a -> Maybe (TreePos Full a)
lastChild :: forall a. TreePos Full a -> Maybe (TreePos Full a)
lastChild = TreePos Empty a -> Maybe (TreePos Full a)
forall a. TreePos Empty a -> Maybe (TreePos Full a)
prevTree (TreePos Empty a -> Maybe (TreePos Full a))
-> (TreePos Full a -> TreePos Empty a)
-> TreePos Full a
-> Maybe (TreePos Full a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Empty a -> TreePos Empty a
forall a. TreePos Empty a -> TreePos Empty a
last (TreePos Empty a -> TreePos Empty a)
-> (TreePos Full a -> TreePos Empty a)
-> TreePos Full a
-> TreePos Empty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
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 :: forall a. Int -> TreePos Full a -> Maybe (TreePos Full a)
childAt Int
n | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 = Maybe (TreePos Full a) -> TreePos Full a -> Maybe (TreePos Full a)
forall a b. a -> b -> a
const Maybe (TreePos Full a)
forall a. Maybe a
Nothing
childAt Int
n         = TreePos Empty a -> Maybe (TreePos Full a)
forall a. TreePos Empty a -> Maybe (TreePos Full a)
nextTree (TreePos Empty a -> Maybe (TreePos Full a))
-> (TreePos Full a -> TreePos Empty a)
-> TreePos Full a
-> Maybe (TreePos Full a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> TreePos Empty a -> TreePos Empty a
forall a. Int -> TreePos Empty a -> TreePos Empty a
spaceAt Int
n (TreePos Empty a -> TreePos Empty a)
-> (TreePos Full a -> TreePos Empty a)
-> TreePos Full a
-> TreePos Empty a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreePos Full a -> TreePos Empty a
forall a. TreePos Full a -> TreePos Empty a
children


-- Conversions -----------------------------------------------------------------

-- | A location corresponding to the root of the given tree.
fromTree :: Tree a -> TreePos Full a
fromTree :: forall a. Tree a -> TreePos Full a
fromTree Tree a
t = Loc { _content :: Full a
_content = Tree a -> Full a
forall a. Tree a -> Full a
F Tree a
t, _before :: Forest a
_before = [], _after :: Forest a
_after = [], _parents :: [(Forest a, a, Forest a)]
_parents = [] }

-- | The location at the beginning of the forest.
fromForest :: Forest a -> TreePos Empty a
fromForest :: forall a. Forest a -> TreePos Empty a
fromForest Forest a
ts = Loc { _content :: Empty a
_content = Empty a
forall a. Empty a
E, _before :: Forest a
_before = [], _after :: Forest a
_after = Forest a
ts, _parents :: [(Forest a, a, Forest a)]
_parents = [] }

-- | The tree containing this location.
toTree :: TreePos Full a -> Tree a
toTree :: forall a. TreePos Full a -> Tree a
toTree TreePos Full a
loc = TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree (TreePos Full a -> TreePos Full a
forall a. TreePos Full a -> TreePos Full a
root TreePos Full a
loc)

-- | The forest containing this location.
toForest :: PosType t => TreePos t a -> Forest a
toForest :: forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
toForest TreePos t a
loc = case TreePos t a -> Maybe (TreePos Full a)
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> Maybe (TreePos Full a)
parent TreePos t a
loc of
                 Maybe (TreePos Full a)
Nothing -> TreePos t a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
forest TreePos t a
loc
                 Just TreePos Full a
p  -> TreePos Full a -> Forest a
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
toForest TreePos Full a
p -- polymprphic recursion


-- Queries ---------------------------------------------------------------------

-- | Are we at the top of the tree?
isRoot :: PosType t => TreePos t a -> Bool
isRoot :: forall (t :: * -> *) a. PosType t => TreePos t a -> Bool
isRoot TreePos t a
loc = [(Forest a, a, Forest a)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TreePos t a -> [(Forest a, a, Forest a)]
forall (t :: * -> *) a.
PosType t =>
TreePos t a -> [(Forest a, a, Forest a)]
parents TreePos t a
loc)

-- | Are we the first position (of its kind) in a forest.
isFirst :: PosType t => TreePos t a -> Bool
isFirst :: forall (t :: * -> *) a. PosType t => TreePos t a -> Bool
isFirst TreePos t a
loc = [Tree a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TreePos t a -> [Tree a]
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
before TreePos t a
loc)

-- | Are we the last position (of its kind) in a forest.
isLast :: PosType t => TreePos t a -> Bool
isLast :: forall (t :: * -> *) a. PosType t => TreePos t a -> Bool
isLast TreePos t a
loc = [Tree a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (TreePos t a -> [Tree a]
forall (t :: * -> *) a. PosType t => TreePos t a -> Forest a
after TreePos t a
loc)

-- | Are we at the bottom of the tree?
isLeaf :: TreePos Full a -> Bool
isLeaf :: forall a. TreePos Full a -> Bool
isLeaf TreePos Full a
loc = [Tree a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (Tree a -> [Tree a]
forall a. Tree a -> [Tree a]
subForest (TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc))

-- | Do we have a parent?
isContained :: PosType t => TreePos t a -> Bool
isContained :: forall (t :: * -> *) a. PosType t => TreePos t a -> Bool
isContained TreePos t a
loc = Bool -> Bool
not (TreePos t a -> Bool
forall (t :: * -> *) a. PosType t => TreePos t a -> Bool
isRoot TreePos t a
loc)

-- | Do we have children?
hasChildren :: TreePos Full a -> Bool
hasChildren :: forall a. TreePos Full a -> Bool
hasChildren TreePos Full a
loc = Bool -> Bool
not (TreePos Full a -> Bool
forall a. TreePos Full a -> Bool
isLeaf TreePos Full a
loc)


-- The current tree -----------------------------------------------------------


-- | The selected tree.
tree :: TreePos Full a -> Tree a
tree :: forall a. TreePos Full a -> Tree a
tree TreePos Full a
x = Full a -> Tree a
forall a. Full a -> Tree a
unF (TreePos Full a -> Full a
forall (t :: * -> *) a. TreePos t a -> t a
_content TreePos Full a
x)

-- | The current label.
label :: TreePos Full a -> a
label :: forall a. TreePos Full a -> a
label TreePos Full a
loc = Tree a -> a
forall a. Tree a -> a
rootLabel (TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc)

-- | Insert a new tree at the current position.
insert :: Tree a -> TreePos Empty a -> TreePos Full a
insert :: forall a. Tree a -> TreePos Empty a -> TreePos Full a
insert Tree a
t TreePos Empty a
loc = TreePos Empty a
loc { _content :: Full a
_content = Tree a -> Full a
forall a. Tree a -> Full a
F Tree a
t }

-- | Remove the tree at the current position.
delete :: TreePos Full a -> TreePos Empty a
delete :: forall a. TreePos Full a -> TreePos Empty a
delete TreePos Full a
loc = TreePos Full a
loc { _content :: Empty a
_content = Empty a
forall a. Empty a
E }



-- | Change the current tree.
setTree :: Tree a -> TreePos Full a -> TreePos Full a
setTree :: forall a. Tree a -> TreePos Full a -> TreePos Full a
setTree Tree a
t TreePos Full a
loc = TreePos Full a
loc { _content :: Full a
_content = Tree a -> Full a
forall a. Tree a -> Full a
F Tree a
t }

-- | Modify the current tree.
modifyTree :: (Tree a -> Tree a) -> TreePos Full a -> TreePos Full a
modifyTree :: forall a. (Tree a -> Tree a) -> TreePos Full a -> TreePos Full a
modifyTree Tree a -> Tree a
f TreePos Full a
loc = Tree a -> TreePos Full a -> TreePos Full a
forall a. Tree a -> TreePos Full a -> TreePos Full a
setTree (Tree a -> Tree a
f (TreePos Full a -> Tree a
forall a. TreePos Full a -> Tree a
tree TreePos Full a
loc)) TreePos Full a
loc

-- | Modify the label at the current node.
modifyLabel :: (a -> a) -> TreePos Full a -> TreePos Full a
modifyLabel :: forall a. (a -> a) -> TreePos Full a -> TreePos Full a
modifyLabel a -> a
f TreePos Full a
loc = a -> TreePos Full a -> TreePos Full a
forall a. a -> TreePos Full a -> TreePos Full a
setLabel (a -> a
f (TreePos Full a -> a
forall a. TreePos Full a -> a
label TreePos Full a
loc)) TreePos Full a
loc

-- | Change the label at the current node.
setLabel :: a -> TreePos Full a -> TreePos Full a
setLabel :: forall a. a -> TreePos Full a -> TreePos Full a
setLabel a
v TreePos Full a
loc = (Tree a -> Tree a) -> TreePos Full a -> TreePos Full a
forall a. (Tree a -> Tree a) -> TreePos Full a -> TreePos Full a
modifyTree (\Tree a
t -> Tree a
t { rootLabel :: a
rootLabel = a
v }) TreePos Full a
loc


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