{-# LANGUAGE RecordWildCards #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Actions.TreeSelect
-- Description :  Zipper over "Data.Tree".
-- Copyright   :  (c) Tom Smeets <tom.tsmeets@gmail.com>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Tom Smeets <tom.tsmeets@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- <https://wiki.haskell.org/Zipper Zipper> over the "Data.Tree" data structure.
-- This module is based on <http://hackage.haskell.org/package/rosezipper rosezipper>.
--
-----------------------------------------------------------------------------

module XMonad.Util.TreeZipper(
    -- * Data structure
      TreeZipper(..)
    , cursor

    -- * Conversion
    , fromForest
    , toForest
    , getSubForest

    -- * Navigation
    , rootNode
    , parent
    , children
    , nextChild
    , previousChild

    -- * Utils
    , nodeDepth
    , nodeIndex
    , followPath
    , findChild

    , isLeaf
    , isRoot
    , isLast
    , isFirst
    ) where

import Data.Tree

-- | A <https://wiki.haskell.org/Zipper Zipper> over the "Data.Tree" data structure.
data TreeZipper a = TreeZipper { forall a. TreeZipper a -> Tree a
tz_current :: Tree a -- ^ the currently focused sub-tree under the cursor
                               , forall a. TreeZipper a -> Forest a
tz_before  :: Forest a -- ^ all sub-tree's to the /left/ of the cursor that have the same parent
                               , forall a. TreeZipper a -> Forest a
tz_after   :: Forest a -- ^ all sub-tree's to the /right/ of the cursor that have the same parent
                               , forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents :: [(Forest a, a, Forest a)] -- ^ list zippers for each parent level, the first element is the current parent
                               }
-- ^ Very crappy visualization of the 'TreeZipper' data structure
--
-- @
--              (tz_parents)
--        ([*],       *, [*])
--        ([*, *],    *, [])
--        ([],        *                  [*,   *])
--                    |                   |    |
--   +-------+--------+-------+------+  +-*-+  *
--   |       |        |       |      |  |   |
--  (tz_before) (tz_current) (tz_after) *   *
--   |       |                |      |
-- +-*-+     *                *      *
-- |   |
-- *   *
-- @

-- | Get the highlighted value
cursor :: TreeZipper a -> a
cursor :: forall a. TreeZipper a -> a
cursor = Tree a -> a
forall a. Tree a -> a
rootLabel (Tree a -> a) -> (TreeZipper a -> Tree a) -> TreeZipper a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> Tree a
forall a. TreeZipper a -> Tree a
tz_current

-- | Create a 'TreeZipper' from a list of 'Data.Tree.Tree's focused on the first element
fromForest :: Forest a -> TreeZipper a
fromForest :: forall a. Forest a -> TreeZipper a
fromForest [] = [Char] -> TreeZipper a
forall a. HasCallStack => [Char] -> a
error [Char]
"XMonad.Util.TreeZipper.fromForest: can't create a TreeZipper from an empty list!"
fromForest (Tree a
x:[Tree a]
xs) = TreeZipper :: forall a.
Tree a
-> Forest a
-> Forest a
-> [(Forest a, a, Forest a)]
-> TreeZipper a
TreeZipper { tz_current :: Tree a
tz_current = Tree a
x
                               , tz_before :: [Tree a]
tz_before  = []
                               , tz_after :: [Tree a]
tz_after   = [Tree a]
xs
                               , tz_parents :: [([Tree a], a, [Tree a])]
tz_parents = []
                               }

-- | Convert the entire zipper back to a 'Data.Tree.Forest'
toForest :: TreeZipper a -> Forest a
toForest :: forall a. TreeZipper a -> Forest a
toForest = TreeZipper a -> Forest a
forall a. TreeZipper a -> Forest a
getSubForest (TreeZipper a -> Forest a)
-> (TreeZipper a -> TreeZipper a) -> TreeZipper a -> Forest a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> TreeZipper a
forall a. TreeZipper a -> TreeZipper a
rootNode

-- | Create a 'Data.Tree.Forest' from all the children of the current parent
getSubForest :: TreeZipper a -> Forest a
getSubForest :: forall a. TreeZipper a -> Forest a
getSubForest TreeZipper{[(Forest a, a, Forest a)]
Forest a
Tree a
tz_parents :: [(Forest a, a, Forest a)]
tz_after :: Forest a
tz_before :: Forest a
tz_current :: Tree a
tz_parents :: forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_after :: forall a. TreeZipper a -> Forest a
tz_before :: forall a. TreeZipper a -> Forest a
tz_current :: forall a. TreeZipper a -> Tree a
..} = Forest a -> Forest a
forall a. [a] -> [a]
reverse Forest a
tz_before Forest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++ Tree a
tz_current Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: Forest a
tz_after

-- | Go to the upper most node such that
-- nothing is before nor above the cursor
rootNode :: TreeZipper a -> TreeZipper a
rootNode :: forall a. TreeZipper a -> TreeZipper a
rootNode = TreeZipper a -> TreeZipper a
forall a. TreeZipper a -> TreeZipper a
f
  where
    f :: TreeZipper a -> TreeZipper a
f TreeZipper a
z = TreeZipper a
-> (TreeZipper a -> TreeZipper a)
-> Maybe (TreeZipper a)
-> TreeZipper a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TreeZipper a -> TreeZipper a
forall a. TreeZipper a -> TreeZipper a
g TreeZipper a
z) TreeZipper a -> TreeZipper a
f (Maybe (TreeZipper a) -> TreeZipper a)
-> Maybe (TreeZipper a) -> TreeZipper a
forall a b. (a -> b) -> a -> b
$ TreeZipper a -> Maybe (TreeZipper a)
forall a. TreeZipper a -> Maybe (TreeZipper a)
parent TreeZipper a
z
    g :: TreeZipper a -> TreeZipper a
g TreeZipper a
z = TreeZipper a
-> (TreeZipper a -> TreeZipper a)
-> Maybe (TreeZipper a)
-> TreeZipper a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe TreeZipper a
z TreeZipper a -> TreeZipper a
g (Maybe (TreeZipper a) -> TreeZipper a)
-> Maybe (TreeZipper a) -> TreeZipper a
forall a b. (a -> b) -> a -> b
$ TreeZipper a -> Maybe (TreeZipper a)
forall a. TreeZipper a -> Maybe (TreeZipper a)
previousChild TreeZipper a
z

-- | Move to the parent node
parent :: TreeZipper a -> Maybe (TreeZipper a)
parent :: forall a. TreeZipper a -> Maybe (TreeZipper a)
parent TreeZipper a
t = case TreeZipper a -> [(Forest a, a, Forest a)]
forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents TreeZipper a
t of
    (Forest a
xs,a
a,Forest a
ys) : [(Forest a, a, Forest a)]
ps -> TreeZipper a -> Maybe (TreeZipper a)
forall a. a -> Maybe a
Just
        TreeZipper :: forall a.
Tree a
-> Forest a
-> Forest a
-> [(Forest a, a, Forest a)]
-> TreeZipper a
TreeZipper { tz_current :: Tree a
tz_current  = a -> Forest a -> Tree a
forall a. a -> [Tree a] -> Tree a
Node a
a (Forest a -> Forest a
forall a. [a] -> [a]
reverse (TreeZipper a -> Forest a
forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
t) Forest a -> Forest a -> Forest a
forall a. [a] -> [a] -> [a]
++ TreeZipper a -> Tree a
forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
t Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: TreeZipper a -> Forest a
forall a. TreeZipper a -> Forest a
tz_after TreeZipper a
t)
                   , tz_before :: Forest a
tz_before   = Forest a
xs
                   , tz_after :: Forest a
tz_after    = Forest a
ys
                   , tz_parents :: [(Forest a, a, Forest a)]
tz_parents  = [(Forest a, a, Forest a)]
ps
                   }
    [] -> Maybe (TreeZipper a)
forall a. Maybe a
Nothing

-- | Move the cursor one level down to the first node
children :: TreeZipper a -> Maybe (TreeZipper a)
children :: forall a. TreeZipper a -> Maybe (TreeZipper a)
children TreeZipper a
z = case Tree a -> [Tree a]
forall a. Tree a -> [Tree a]
subForest (Tree a -> [Tree a]) -> Tree a -> [Tree a]
forall a b. (a -> b) -> a -> b
$ TreeZipper a -> Tree a
forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
z of
    (Tree a
n:[Tree a]
xs) -> TreeZipper a -> Maybe (TreeZipper a)
forall a. a -> Maybe a
Just
        TreeZipper :: forall a.
Tree a
-> Forest a
-> Forest a
-> [(Forest a, a, Forest a)]
-> TreeZipper a
TreeZipper { tz_current :: Tree a
tz_current = Tree a
n
                   , tz_before :: [Tree a]
tz_before  = []
                   , tz_after :: [Tree a]
tz_after   = [Tree a]
xs
                   , tz_parents :: [([Tree a], a, [Tree a])]
tz_parents = (TreeZipper a -> [Tree a]
forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
z, TreeZipper a -> a
forall a. TreeZipper a -> a
cursor TreeZipper a
z, TreeZipper a -> [Tree a]
forall a. TreeZipper a -> Forest a
tz_after TreeZipper a
z) ([Tree a], a, [Tree a])
-> [([Tree a], a, [Tree a])] -> [([Tree a], a, [Tree a])]
forall a. a -> [a] -> [a]
: TreeZipper a -> [([Tree a], a, [Tree a])]
forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents TreeZipper a
z
                   }
    [] -> Maybe (TreeZipper a)
forall a. Maybe a
Nothing

-- | Go to the next child node
nextChild :: TreeZipper a -> Maybe (TreeZipper a)
nextChild :: forall a. TreeZipper a -> Maybe (TreeZipper a)
nextChild TreeZipper a
z = case TreeZipper a -> Forest a
forall a. TreeZipper a -> Forest a
tz_after TreeZipper a
z of
    (Tree a
n:Forest a
xs) -> TreeZipper a -> Maybe (TreeZipper a)
forall a. a -> Maybe a
Just
        TreeZipper :: forall a.
Tree a
-> Forest a
-> Forest a
-> [(Forest a, a, Forest a)]
-> TreeZipper a
TreeZipper { tz_current :: Tree a
tz_current = Tree a
n
                   , tz_before :: Forest a
tz_before  = TreeZipper a -> Tree a
forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
z Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: TreeZipper a -> Forest a
forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
z
                   , tz_after :: Forest a
tz_after   = Forest a
xs
                   , tz_parents :: [(Forest a, a, Forest a)]
tz_parents = TreeZipper a -> [(Forest a, a, Forest a)]
forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents TreeZipper a
z
                   }
    [] -> Maybe (TreeZipper a)
forall a. Maybe a
Nothing

-- | Go to the previous child node
previousChild :: TreeZipper a -> Maybe (TreeZipper a)
previousChild :: forall a. TreeZipper a -> Maybe (TreeZipper a)
previousChild TreeZipper a
z = case TreeZipper a -> Forest a
forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
z of
    (Tree a
n:Forest a
xs) -> TreeZipper a -> Maybe (TreeZipper a)
forall a. a -> Maybe a
Just
        TreeZipper :: forall a.
Tree a
-> Forest a
-> Forest a
-> [(Forest a, a, Forest a)]
-> TreeZipper a
TreeZipper { tz_current :: Tree a
tz_current = Tree a
n
                   , tz_before :: Forest a
tz_before  = Forest a
xs
                   , tz_after :: Forest a
tz_after   = TreeZipper a -> Tree a
forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
z Tree a -> Forest a -> Forest a
forall a. a -> [a] -> [a]
: TreeZipper a -> Forest a
forall a. TreeZipper a -> Forest a
tz_after TreeZipper a
z
                   , tz_parents :: [(Forest a, a, Forest a)]
tz_parents = TreeZipper a -> [(Forest a, a, Forest a)]
forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents TreeZipper a
z
                   }
    [] -> Maybe (TreeZipper a)
forall a. Maybe a
Nothing

-- | How many nodes are above this one?
nodeDepth :: TreeZipper a -> Int
nodeDepth :: forall a. TreeZipper a -> Int
nodeDepth = [(Forest a, a, Forest a)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([(Forest a, a, Forest a)] -> Int)
-> (TreeZipper a -> [(Forest a, a, Forest a)])
-> TreeZipper a
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> [(Forest a, a, Forest a)]
forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents

-- | How many nodes are before the cursor? (on the current level)
nodeIndex :: TreeZipper a -> Int
nodeIndex :: forall a. TreeZipper a -> Int
nodeIndex = [Tree a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Tree a] -> Int)
-> (TreeZipper a -> [Tree a]) -> TreeZipper a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> [Tree a]
forall a. TreeZipper a -> Forest a
tz_before

-- | follow a Path specified by the list of nodes
followPath :: Eq b => (a -> b) -> [b] -> TreeZipper a -> Maybe (TreeZipper a)
followPath :: forall b a.
Eq b =>
(a -> b) -> [b] -> TreeZipper a -> Maybe (TreeZipper a)
followPath a -> b
_ []     TreeZipper a
z = TreeZipper a -> Maybe (TreeZipper a)
forall a. a -> Maybe a
Just TreeZipper a
z
followPath a -> b
f [b
x]    TreeZipper a
z = (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
forall a. (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
findChild (\a
y -> a -> b
f a
y b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x) TreeZipper a
z
followPath a -> b
f (b
x:[b]
xs) TreeZipper a
z = (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
forall a. (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
findChild (\a
y -> a -> b
f a
y b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
x) TreeZipper a
z Maybe (TreeZipper a)
-> (TreeZipper a -> Maybe (TreeZipper a)) -> Maybe (TreeZipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= TreeZipper a -> Maybe (TreeZipper a)
forall a. TreeZipper a -> Maybe (TreeZipper a)
children Maybe (TreeZipper a)
-> (TreeZipper a -> Maybe (TreeZipper a)) -> Maybe (TreeZipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> b) -> [b] -> TreeZipper a -> Maybe (TreeZipper a)
forall b a.
Eq b =>
(a -> b) -> [b] -> TreeZipper a -> Maybe (TreeZipper a)
followPath a -> b
f [b]
xs

-- | go to the first node next to the cursor that matches
findChild :: (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
findChild :: forall a. (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
findChild a -> Bool
f TreeZipper a
z | a -> Bool
f (TreeZipper a -> a
forall a. TreeZipper a -> a
cursor TreeZipper a
z) = TreeZipper a -> Maybe (TreeZipper a)
forall a. a -> Maybe a
Just TreeZipper a
z
              | Bool
otherwise    = TreeZipper a -> Maybe (TreeZipper a)
forall a. TreeZipper a -> Maybe (TreeZipper a)
nextChild TreeZipper a
z Maybe (TreeZipper a)
-> (TreeZipper a -> Maybe (TreeZipper a)) -> Maybe (TreeZipper a)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
forall a. (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
findChild a -> Bool
f

-- | Check whenther this is a leaf node
isLeaf :: TreeZipper a -> Bool
isLeaf :: forall a. TreeZipper a -> Bool
isLeaf = [Tree a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree a] -> Bool)
-> (TreeZipper a -> [Tree a]) -> TreeZipper a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Tree a -> [Tree a]
forall a. Tree a -> [Tree a]
subForest (Tree a -> [Tree a])
-> (TreeZipper a -> Tree a) -> TreeZipper a -> [Tree a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> Tree a
forall a. TreeZipper a -> Tree a
tz_current

-- | Check whenther this is a leaf node
isRoot :: TreeZipper a -> Bool
isRoot :: forall a. TreeZipper a -> Bool
isRoot = [(Forest a, a, Forest a)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([(Forest a, a, Forest a)] -> Bool)
-> (TreeZipper a -> [(Forest a, a, Forest a)])
-> TreeZipper a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> [(Forest a, a, Forest a)]
forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents

-- | Check whenther this the last child
isLast :: TreeZipper a -> Bool
isLast :: forall a. TreeZipper a -> Bool
isLast = [Tree a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree a] -> Bool)
-> (TreeZipper a -> [Tree a]) -> TreeZipper a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> [Tree a]
forall a. TreeZipper a -> Forest a
tz_after

-- | Check whenther this the first child
isFirst :: TreeZipper a -> Bool
isFirst :: forall a. TreeZipper a -> Bool
isFirst = [Tree a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Tree a] -> Bool)
-> (TreeZipper a -> [Tree a]) -> TreeZipper a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TreeZipper a -> [Tree a]
forall a. TreeZipper a -> Forest a
tz_before