{-# 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