{-# 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 = forall a. Tree a -> a
rootLabel forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 [] = 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 { 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 = forall a. TreeZipper a -> Forest a
getSubForest forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
..} = forall a. [a] -> [a]
reverse Forest a
tz_before forall a. [a] -> [a] -> [a]
++ Tree a
tz_current 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 = forall a. TreeZipper a -> TreeZipper a
f
  where
    f :: TreeZipper a -> TreeZipper a
f TreeZipper a
z = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. TreeZipper a -> TreeZipper a
g TreeZipper a
z) TreeZipper a -> TreeZipper a
f forall a b. (a -> b) -> a -> b
$ forall a. TreeZipper a -> Maybe (TreeZipper a)
parent TreeZipper a
z
    g :: TreeZipper a -> TreeZipper a
g TreeZipper a
z = forall b a. b -> (a -> b) -> Maybe a -> b
maybe TreeZipper a
z TreeZipper a -> TreeZipper a
g forall a b. (a -> b) -> a -> b
$ 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 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 -> forall a. a -> Maybe a
Just
        TreeZipper { tz_current :: Tree a
tz_current  = forall a. a -> [Tree a] -> Tree a
Node a
a (forall a. [a] -> [a]
reverse (forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
t) forall a. [a] -> [a] -> [a]
++ forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
t forall a. a -> [a] -> [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
                   }
    [] -> 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 forall a. Tree a -> [Tree a]
subForest forall a b. (a -> b) -> a -> b
$ forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
z of
    (Tree a
n:[Tree a]
xs) -> forall a. a -> Maybe a
Just
        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 = (forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
z, forall a. TreeZipper a -> a
cursor TreeZipper a
z, forall a. TreeZipper a -> Forest a
tz_after TreeZipper a
z) forall a. a -> [a] -> [a]
: forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents TreeZipper a
z
                   }
    [] -> 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 forall a. TreeZipper a -> Forest a
tz_after TreeZipper a
z of
    (Tree a
n:[Tree a]
xs) -> forall a. a -> Maybe a
Just
        TreeZipper { tz_current :: Tree a
tz_current = Tree a
n
                   , tz_before :: [Tree a]
tz_before  = forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
z forall a. a -> [a] -> [a]
: forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
z
                   , tz_after :: [Tree a]
tz_after   = [Tree a]
xs
                   , tz_parents :: [([Tree a], a, [Tree a])]
tz_parents = forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents TreeZipper a
z
                   }
    [] -> 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 forall a. TreeZipper a -> Forest a
tz_before TreeZipper a
z of
    (Tree a
n:[Tree a]
xs) -> forall a. a -> Maybe a
Just
        TreeZipper { tz_current :: Tree a
tz_current = Tree a
n
                   , tz_before :: [Tree a]
tz_before  = [Tree a]
xs
                   , tz_after :: [Tree a]
tz_after   = forall a. TreeZipper a -> Tree a
tz_current TreeZipper a
z forall a. a -> [a] -> [a]
: forall a. TreeZipper a -> Forest a
tz_after TreeZipper a
z
                   , tz_parents :: [([Tree a], a, [Tree a])]
tz_parents = forall a. TreeZipper a -> [(Forest a, a, Forest a)]
tz_parents TreeZipper a
z
                   }
    [] -> forall a. Maybe a
Nothing

-- | How many nodes are above this one?
nodeDepth :: TreeZipper a -> Int
nodeDepth :: forall a. TreeZipper a -> Int
nodeDepth = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) a. Foldable t => t a -> Int
length forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. a -> Maybe a
Just TreeZipper a
z
followPath a -> b
f [b
x]    TreeZipper a
z = forall a. (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
findChild (\a
y -> a -> b
f a
y forall a. Eq a => a -> a -> Bool
== b
x) TreeZipper a
z
followPath a -> b
f (b
x:[b]
xs) TreeZipper a
z = forall a. (a -> Bool) -> TreeZipper a -> Maybe (TreeZipper a)
findChild (\a
y -> a -> b
f a
y forall a. Eq a => a -> a -> Bool
== b
x) TreeZipper a
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. TreeZipper a -> Maybe (TreeZipper a)
children forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 (forall a. TreeZipper a -> a
cursor TreeZipper a
z) = forall a. a -> Maybe a
Just TreeZipper a
z
              | Bool
otherwise    = forall a. TreeZipper a -> Maybe (TreeZipper a)
nextChild TreeZipper a
z forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Tree a -> [Tree a]
subForest forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. TreeZipper a -> Forest a
tz_before