{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Cursor.Tree.Base
  ( singletonTreeCursor,
    makeTreeCursor,
    makeNodeTreeCursor,
    makeTreeCursorWithSelection,
    rebuildTreeCursor,
    mapTreeCursor,
    currentTree,
    makeTreeCursorWithAbove,
    traverseTreeCursor,
    foldTreeCursor,
  )
where

import Control.Monad
import Cursor.Tree.Types

singletonTreeCursor :: a -> TreeCursor a b
singletonTreeCursor :: a -> TreeCursor a b
singletonTreeCursor a
v = TreeCursor :: forall a b. Maybe (TreeAbove b) -> a -> CForest b -> TreeCursor a b
TreeCursor {treeAbove :: Maybe (TreeAbove b)
treeAbove = Maybe (TreeAbove b)
forall a. Maybe a
Nothing, treeCurrent :: a
treeCurrent = a
v, treeBelow :: CForest b
treeBelow = CForest b
forall a. CForest a
emptyCForest}

makeTreeCursor :: (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor :: (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g (CNode b
v CForest b
fs) = TreeCursor :: forall a b. Maybe (TreeAbove b) -> a -> CForest b -> TreeCursor a b
TreeCursor {treeAbove :: Maybe (TreeAbove b)
treeAbove = Maybe (TreeAbove b)
forall a. Maybe a
Nothing, treeCurrent :: a
treeCurrent = b -> a
g b
v, treeBelow :: CForest b
treeBelow = CForest b
fs}

makeNodeTreeCursor :: a -> CForest b -> TreeCursor a b
makeNodeTreeCursor :: a -> CForest b -> TreeCursor a b
makeNodeTreeCursor a
v CForest b
fs = TreeCursor :: forall a b. Maybe (TreeAbove b) -> a -> CForest b -> TreeCursor a b
TreeCursor {treeAbove :: Maybe (TreeAbove b)
treeAbove = Maybe (TreeAbove b)
forall a. Maybe a
Nothing, treeCurrent :: a
treeCurrent = a
v, treeBelow :: CForest b
treeBelow = CForest b
fs}

makeTreeCursorWithSelection ::
  (a -> b) -> (b -> a) -> TreeCursorSelection -> CTree b -> Maybe (TreeCursor a b)
makeTreeCursorWithSelection :: (a -> b)
-> (b -> a)
-> TreeCursorSelection
-> CTree b
-> Maybe (TreeCursor a b)
makeTreeCursorWithSelection a -> b
f b -> a
g TreeCursorSelection
sel = TreeCursorSelection -> TreeCursor a b -> Maybe (TreeCursor a b)
walkDown TreeCursorSelection
sel (TreeCursor a b -> Maybe (TreeCursor a b))
-> (CTree b -> TreeCursor a b) -> CTree b -> Maybe (TreeCursor a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> CTree b -> TreeCursor a b
forall b a. (b -> a) -> CTree b -> TreeCursor a b
makeTreeCursor b -> a
g
  where
    walkDown :: TreeCursorSelection -> TreeCursor a b -> Maybe (TreeCursor a b)
walkDown TreeCursorSelection
SelectNode TreeCursor a b
tc = TreeCursor a b -> Maybe (TreeCursor a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure TreeCursor a b
tc
    walkDown (SelectChild Int
i TreeCursorSelection
s) TreeCursor {a
Maybe (TreeAbove b)
CForest b
treeBelow :: CForest b
treeCurrent :: a
treeAbove :: Maybe (TreeAbove b)
treeBelow :: forall a b. TreeCursor a b -> CForest b
treeCurrent :: forall a b. TreeCursor a b -> a
treeAbove :: forall a b. TreeCursor a b -> Maybe (TreeAbove b)
..} =
      (TreeCursorSelection -> TreeCursor a b -> Maybe (TreeCursor a b)
walkDown TreeCursorSelection
s (TreeCursor a b -> Maybe (TreeCursor a b))
-> Maybe (TreeCursor a b) -> Maybe (TreeCursor a b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<) (Maybe (TreeCursor a b) -> Maybe (TreeCursor a b))
-> Maybe (TreeCursor a b) -> Maybe (TreeCursor a b)
forall a b. (a -> b) -> a -> b
$
        case Int -> [CTree b] -> ([CTree b], [CTree b])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
i ([CTree b] -> ([CTree b], [CTree b]))
-> [CTree b] -> ([CTree b], [CTree b])
forall a b. (a -> b) -> a -> b
$ CForest b -> [CTree b]
forall a. CForest a -> [CTree a]
unpackCForest CForest b
treeBelow of
          ([CTree b]
_, []) -> Maybe (TreeCursor a b)
forall a. Maybe a
Nothing
          ([CTree b]
lefts, CTree b
current : [CTree b]
rights) ->
            TreeCursor a b -> Maybe (TreeCursor a b)
forall a. a -> Maybe a
Just (TreeCursor a b -> Maybe (TreeCursor a b))
-> TreeCursor a b -> Maybe (TreeCursor a b)
forall a b. (a -> b) -> a -> b
$
              (b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
forall b a.
(b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
makeTreeCursorWithAbove b -> a
g CTree b
current (Maybe (TreeAbove b) -> TreeCursor a b)
-> Maybe (TreeAbove b) -> TreeCursor a b
forall a b. (a -> b) -> a -> b
$
                TreeAbove b -> Maybe (TreeAbove b)
forall a. a -> Maybe a
Just (TreeAbove b -> Maybe (TreeAbove b))
-> TreeAbove b -> Maybe (TreeAbove b)
forall a b. (a -> b) -> a -> b
$
                  TreeAbove :: forall b.
[CTree b] -> Maybe (TreeAbove b) -> b -> [CTree b] -> TreeAbove b
TreeAbove
                    { treeAboveLefts :: [CTree b]
treeAboveLefts = [CTree b] -> [CTree b]
forall a. [a] -> [a]
reverse [CTree b]
lefts,
                      treeAboveAbove :: Maybe (TreeAbove b)
treeAboveAbove = Maybe (TreeAbove b)
treeAbove,
                      treeAboveNode :: b
treeAboveNode = a -> b
f a
treeCurrent,
                      treeAboveRights :: [CTree b]
treeAboveRights = [CTree b]
rights
                    }

rebuildTreeCursor :: (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor :: (a -> b) -> TreeCursor a b -> CTree b
rebuildTreeCursor a -> b
f TreeCursor {a
Maybe (TreeAbove b)
CForest b
treeBelow :: CForest b
treeCurrent :: a
treeAbove :: Maybe (TreeAbove b)
treeBelow :: forall a b. TreeCursor a b -> CForest b
treeCurrent :: forall a b. TreeCursor a b -> a
treeAbove :: forall a b. TreeCursor a b -> Maybe (TreeAbove b)
..} = Maybe (TreeAbove b) -> CTree b -> CTree b
forall a. Maybe (TreeAbove a) -> CTree a -> CTree a
wrapAbove Maybe (TreeAbove b)
treeAbove (CTree b -> CTree b) -> CTree b -> CTree b
forall a b. (a -> b) -> a -> b
$ b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode (a -> b
f a
treeCurrent) CForest b
treeBelow
  where
    wrapAbove :: Maybe (TreeAbove a) -> CTree a -> CTree a
wrapAbove Maybe (TreeAbove a)
Nothing CTree a
t = CTree a
t
    wrapAbove (Just TreeAbove {a
[CTree a]
Maybe (TreeAbove a)
treeAboveRights :: [CTree a]
treeAboveNode :: a
treeAboveAbove :: Maybe (TreeAbove a)
treeAboveLefts :: [CTree a]
treeAboveRights :: forall b. TreeAbove b -> [CTree b]
treeAboveNode :: forall b. TreeAbove b -> b
treeAboveAbove :: forall b. TreeAbove b -> Maybe (TreeAbove b)
treeAboveLefts :: forall b. TreeAbove b -> [CTree b]
..}) CTree a
t =
      Maybe (TreeAbove a) -> CTree a -> CTree a
wrapAbove Maybe (TreeAbove a)
treeAboveAbove (CTree a -> CTree a) -> CTree a -> CTree a
forall a b. (a -> b) -> a -> b
$
        a -> CForest a -> CTree a
forall a. a -> CForest a -> CTree a
CNode a
treeAboveNode (CForest a -> CTree a) -> CForest a -> CTree a
forall a b. (a -> b) -> a -> b
$
          [CTree a] -> CForest a
forall a. [CTree a] -> CForest a
openForest ([CTree a] -> CForest a) -> [CTree a] -> CForest a
forall a b. (a -> b) -> a -> b
$
            [[CTree a]] -> [CTree a]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[CTree a] -> [CTree a]
forall a. [a] -> [a]
reverse [CTree a]
treeAboveLefts, [CTree a
t], [CTree a]
treeAboveRights]

mapTreeCursor :: (a -> c) -> (b -> d) -> TreeCursor a b -> TreeCursor c d
mapTreeCursor :: (a -> c) -> (b -> d) -> TreeCursor a b -> TreeCursor c d
mapTreeCursor a -> c
f b -> d
g TreeCursor {a
Maybe (TreeAbove b)
CForest b
treeBelow :: CForest b
treeCurrent :: a
treeAbove :: Maybe (TreeAbove b)
treeBelow :: forall a b. TreeCursor a b -> CForest b
treeCurrent :: forall a b. TreeCursor a b -> a
treeAbove :: forall a b. TreeCursor a b -> Maybe (TreeAbove b)
..} =
  TreeCursor :: forall a b. Maybe (TreeAbove b) -> a -> CForest b -> TreeCursor a b
TreeCursor
    { treeAbove :: Maybe (TreeAbove d)
treeAbove = (b -> d) -> TreeAbove b -> TreeAbove d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> d
g (TreeAbove b -> TreeAbove d)
-> Maybe (TreeAbove b) -> Maybe (TreeAbove d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (TreeAbove b)
treeAbove,
      treeCurrent :: c
treeCurrent = a -> c
f a
treeCurrent,
      treeBelow :: CForest d
treeBelow = (b -> d) -> CForest b -> CForest d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> d
g CForest b
treeBelow
    }

currentTree :: (a -> b) -> TreeCursor a b -> CTree b
currentTree :: (a -> b) -> TreeCursor a b -> CTree b
currentTree a -> b
f TreeCursor {a
Maybe (TreeAbove b)
CForest b
treeBelow :: CForest b
treeCurrent :: a
treeAbove :: Maybe (TreeAbove b)
treeBelow :: forall a b. TreeCursor a b -> CForest b
treeCurrent :: forall a b. TreeCursor a b -> a
treeAbove :: forall a b. TreeCursor a b -> Maybe (TreeAbove b)
..} = b -> CForest b -> CTree b
forall a. a -> CForest a -> CTree a
CNode (a -> b
f a
treeCurrent) CForest b
treeBelow

makeTreeCursorWithAbove :: (b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
makeTreeCursorWithAbove :: (b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b
makeTreeCursorWithAbove b -> a
g (CNode b
a CForest b
forest) Maybe (TreeAbove b)
mta =
  TreeCursor :: forall a b. Maybe (TreeAbove b) -> a -> CForest b -> TreeCursor a b
TreeCursor {treeAbove :: Maybe (TreeAbove b)
treeAbove = Maybe (TreeAbove b)
mta, treeCurrent :: a
treeCurrent = b -> a
g b
a, treeBelow :: CForest b
treeBelow = CForest b
forest}

traverseTreeCursor ::
  forall a b m c.
  Monad m =>
  ([CTree b] -> b -> [CTree b] -> c -> m c) ->
  (a -> CForest b -> m c) ->
  TreeCursor a b ->
  m c
traverseTreeCursor :: ([CTree b] -> b -> [CTree b] -> c -> m c)
-> (a -> CForest b -> m c) -> TreeCursor a b -> m c
traverseTreeCursor [CTree b] -> b -> [CTree b] -> c -> m c
wrapFunc a -> CForest b -> m c
currentFunc TreeCursor {a
Maybe (TreeAbove b)
CForest b
treeBelow :: CForest b
treeCurrent :: a
treeAbove :: Maybe (TreeAbove b)
treeBelow :: forall a b. TreeCursor a b -> CForest b
treeCurrent :: forall a b. TreeCursor a b -> a
treeAbove :: forall a b. TreeCursor a b -> Maybe (TreeAbove b)
..} =
  a -> CForest b -> m c
currentFunc a
treeCurrent CForest b
treeBelow m c -> (c -> m c) -> m c
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe (TreeAbove b) -> c -> m c
wrapAbove Maybe (TreeAbove b)
treeAbove
  where
    wrapAbove :: Maybe (TreeAbove b) -> c -> m c
    wrapAbove :: Maybe (TreeAbove b) -> c -> m c
wrapAbove Maybe (TreeAbove b)
Nothing = c -> m c
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    wrapAbove (Just TreeAbove b
ta) = TreeAbove b -> c -> m c
goAbove TreeAbove b
ta
    goAbove :: TreeAbove b -> c -> m c
    goAbove :: TreeAbove b -> c -> m c
goAbove TreeAbove {b
[CTree b]
Maybe (TreeAbove b)
treeAboveRights :: [CTree b]
treeAboveNode :: b
treeAboveAbove :: Maybe (TreeAbove b)
treeAboveLefts :: [CTree b]
treeAboveRights :: forall b. TreeAbove b -> [CTree b]
treeAboveNode :: forall b. TreeAbove b -> b
treeAboveAbove :: forall b. TreeAbove b -> Maybe (TreeAbove b)
treeAboveLefts :: forall b. TreeAbove b -> [CTree b]
..} =
      [CTree b] -> b -> [CTree b] -> c -> m c
wrapFunc ([CTree b] -> [CTree b]
forall a. [a] -> [a]
reverse [CTree b]
treeAboveLefts) b
treeAboveNode [CTree b]
treeAboveRights (c -> m c) -> (c -> m c) -> c -> m c
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Maybe (TreeAbove b) -> c -> m c
wrapAbove Maybe (TreeAbove b)
treeAboveAbove

foldTreeCursor ::
  forall a b c.
  ([CTree b] -> b -> [CTree b] -> c -> c) ->
  (a -> CForest b -> c) ->
  TreeCursor a b ->
  c
foldTreeCursor :: ([CTree b] -> b -> [CTree b] -> c -> c)
-> (a -> CForest b -> c) -> TreeCursor a b -> c
foldTreeCursor [CTree b] -> b -> [CTree b] -> c -> c
wrapFunc a -> CForest b -> c
currentFunc TreeCursor {a
Maybe (TreeAbove b)
CForest b
treeBelow :: CForest b
treeCurrent :: a
treeAbove :: Maybe (TreeAbove b)
treeBelow :: forall a b. TreeCursor a b -> CForest b
treeCurrent :: forall a b. TreeCursor a b -> a
treeAbove :: forall a b. TreeCursor a b -> Maybe (TreeAbove b)
..} =
  Maybe (TreeAbove b) -> c -> c
wrapAbove Maybe (TreeAbove b)
treeAbove (c -> c) -> c -> c
forall a b. (a -> b) -> a -> b
$ a -> CForest b -> c
currentFunc a
treeCurrent CForest b
treeBelow
  where
    wrapAbove :: Maybe (TreeAbove b) -> c -> c
    wrapAbove :: Maybe (TreeAbove b) -> c -> c
wrapAbove Maybe (TreeAbove b)
Nothing = c -> c
forall a. a -> a
id
    wrapAbove (Just TreeAbove b
ta) = TreeAbove b -> c -> c
goAbove TreeAbove b
ta
    goAbove :: TreeAbove b -> c -> c
    goAbove :: TreeAbove b -> c -> c
goAbove TreeAbove {b
[CTree b]
Maybe (TreeAbove b)
treeAboveRights :: [CTree b]
treeAboveNode :: b
treeAboveAbove :: Maybe (TreeAbove b)
treeAboveLefts :: [CTree b]
treeAboveRights :: forall b. TreeAbove b -> [CTree b]
treeAboveNode :: forall b. TreeAbove b -> b
treeAboveAbove :: forall b. TreeAbove b -> Maybe (TreeAbove b)
treeAboveLefts :: forall b. TreeAbove b -> [CTree b]
..} =
      Maybe (TreeAbove b) -> c -> c
wrapAbove Maybe (TreeAbove b)
treeAboveAbove (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [CTree b] -> b -> [CTree b] -> c -> c
wrapFunc ([CTree b] -> [CTree b]
forall a. [a] -> [a]
reverse [CTree b]
treeAboveLefts) b
treeAboveNode [CTree b]
treeAboveRights