cursor (empty) → 0.0.0.0
raw patch · 27 files changed
+4071/−0 lines, 27 filesdep +basedep +containersdep +microlenssetup-changed
Dependencies added: base, containers, microlens, text, validity, validity-containers, validity-text
Files
- LICENSE +21/−0
- Setup.hs +3/−0
- cursor.cabal +60/−0
- src/Cursor/Forest.hs +743/−0
- src/Cursor/List.hs +151/−0
- src/Cursor/List/NonEmpty.hs +294/−0
- src/Cursor/Map.hs +287/−0
- src/Cursor/Map/KeyValue.hs +98/−0
- src/Cursor/Simple/Forest.hs +204/−0
- src/Cursor/Simple/List/NonEmpty.hs +114/−0
- src/Cursor/Simple/Map.hs +117/−0
- src/Cursor/Simple/Map/KeyValue.hs +36/−0
- src/Cursor/Simple/Tree.hs +212/−0
- src/Cursor/Text.hs +125/−0
- src/Cursor/TextField.hs +286/−0
- src/Cursor/Tree.hs +37/−0
- src/Cursor/Tree/Base.hs +74/−0
- src/Cursor/Tree/Collapse.hs +34/−0
- src/Cursor/Tree/Delete.hs +179/−0
- src/Cursor/Tree/Demote.hs +172/−0
- src/Cursor/Tree/Draw.hs +52/−0
- src/Cursor/Tree/Insert.hs +88/−0
- src/Cursor/Tree/Movement.hs +187/−0
- src/Cursor/Tree/Promote.hs +181/−0
- src/Cursor/Tree/Swap.hs +90/−0
- src/Cursor/Tree/Types.hs +157/−0
- src/Cursor/Types.hs +69/−0
+ LICENSE view
@@ -0,0 +1,21 @@+MIT License++Copyright (c) 2018 Tom Sydney Kerckhove++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,3 @@+import Distribution.Simple++main = defaultMain
+ cursor.cabal view
@@ -0,0 +1,60 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 02faf660887f273e997cf0722b08edb14f51ed1f1ef1a064ee50ae52994ee175++name: cursor+version: 0.0.0.0+synopsis: Purely Functional Cursors+description: Purely Functional Cursors for common data structures+category: Editor+homepage: https://github.com/NorfairKing/cursor+author: Tom Sydney Kerckhove+maintainer: syd@cs-syd.eu+copyright: Copyright: (c) 2018 Tom Sydney Kerckhove+license: MIT+license-file: LICENSE+build-type: Simple+cabal-version: >= 1.10++library+ exposed-modules:+ Cursor.Forest+ Cursor.List+ Cursor.List.NonEmpty+ Cursor.Map+ Cursor.Map.KeyValue+ Cursor.Simple.Forest+ Cursor.Simple.List.NonEmpty+ Cursor.Simple.Map+ Cursor.Simple.Map.KeyValue+ Cursor.Simple.Tree+ Cursor.Text+ Cursor.TextField+ Cursor.Tree+ Cursor.Tree.Base+ Cursor.Tree.Collapse+ Cursor.Tree.Delete+ Cursor.Tree.Demote+ Cursor.Tree.Draw+ Cursor.Tree.Insert+ Cursor.Tree.Movement+ Cursor.Tree.Promote+ Cursor.Tree.Swap+ Cursor.Tree.Types+ Cursor.Types+ other-modules:+ Paths_cursor+ hs-source-dirs:+ src/+ ghc-options: -Wall+ build-depends:+ base <5+ , containers+ , microlens+ , text+ , validity+ , validity-containers+ , validity-text+ default-language: Haskell2010
+ src/Cursor/Forest.hs view
@@ -0,0 +1,743 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Forest+ ( ForestCursor(..)+ , makeForestCursor+ , rebuildForestCursor+ , drawForestCursor+ , mapForestCursor+ , forestCursorListCursorL+ , forestCursorSelectedTreeL+ , forestCursorSelectPrevTreeCursor+ , forestCursorSelectNextTreeCursor+ , forestCursorSelectFirstTreeCursor+ , forestCursorSelectLastTreeCursor+ , forestCursorSelectPrev+ , forestCursorSelectNext+ , forestCursorSelectPrevOnSameLevel+ , forestCursorSelectNextOnSameLevel+ , forestCursorSelectFirst+ , forestCursorSelectLast+ , forestCursorSelectBelowAtPos+ , forestCursorSelectBelowAtStart+ , forestCursorSelectBelowAtEnd+ , forestCursorSelection+ , forestCursorSelectIndex+ , forestCursorCloseCurrentForest+ , forestCursorOpenCurrentForest+ , forestCursorToggleCurrentForest+ , forestCursorInsertEntireTree+ , forestCursorAppendEntireTree+ , forestCursorInsertAndSelectTreeCursor+ , forestCursorAppendAndSelectTreeCursor+ , forestCursorInsertTree+ , forestCursorAppendTree+ , forestCursorInsertAndSelectTree+ , forestCursorAppendAndSelectTree+ , forestCursorInsert+ , forestCursorAppend+ , forestCursorInsertAndSelect+ , forestCursorAppendAndSelect+ , forestCursorAddChildTreeToNodeAtPos+ , forestCursorAddChildTreeToNodeAtStart+ , forestCursorAddChildTreeToNodeAtEnd+ , forestCursorAddChildToNodeAtPos+ , forestCursorAddChildToNodeAtStart+ , forestCursorAddChildToNodeAtEnd+ , forestCursorRemoveElemAndSelectPrev+ , forestCursorDeleteElemAndSelectNext+ , forestCursorRemoveElem+ , forestCursorDeleteElem+ , forestCursorRemoveSubTreeAndSelectPrev+ , forestCursorDeleteSubTreeAndSelectNext+ , forestCursorRemoveSubTree+ , forestCursorDeleteSubTree+ , forestCursorAddRoot+ , forestCursorSwapPrev+ , forestCursorSwapNext+ , forestCursorPromoteElem+ , forestCursorPromoteSubTree+ , forestCursorDemoteElem+ , forestCursorDemoteSubTree+ , forestCursorDemoteElemUnder+ , forestCursorDemoteSubTreeUnder+ , CTree(..)+ , makeCTree+ , cTree+ , rebuildCTree+ , CForest(..)+ , makeCForest+ , cForest+ , rebuildCForest+ ) where++import GHC.Generics (Generic)++import Data.Validity+import Data.Validity.Tree ()++import Data.List.NonEmpty (NonEmpty)+import Data.Maybe+import Data.Tree++import Control.Applicative++import Lens.Micro++import Cursor.List.NonEmpty+import Cursor.Tree+import Cursor.Types++newtype ForestCursor a b = ForestCursor+ { forestCursorListCursor :: NonEmptyCursor (TreeCursor a b) (CTree b)+ } deriving (Show, Eq, Generic)++instance (Validity a, Validity b) => Validity (ForestCursor a b)++makeForestCursor :: (b -> a) -> NonEmpty (CTree b) -> ForestCursor a b+makeForestCursor g = ForestCursor . makeNonEmptyCursor (makeTreeCursor g)++rebuildForestCursor :: (a -> b) -> ForestCursor a b -> NonEmpty (CTree b)+rebuildForestCursor f =+ rebuildNonEmptyCursor (rebuildTreeCursor f) . forestCursorListCursor++drawForestCursor :: (Show a, Show b) => ForestCursor a b -> String+drawForestCursor ForestCursor {..} =+ drawForest $+ (map showCTree $ reverse $ nonEmptyCursorPrev forestCursorListCursor) +++ [treeCursorWithPointer $ nonEmptyCursorCurrent forestCursorListCursor] +++ (map showCTree $ nonEmptyCursorNext forestCursorListCursor)++mapForestCursor :: (a -> c) -> (b -> d) -> ForestCursor a b -> ForestCursor c d+mapForestCursor f g =+ forestCursorListCursorL %~ mapNonEmptyCursor (mapTreeCursor f g) (fmap g)++forestCursorListCursorL ::+ Lens (ForestCursor a b) (ForestCursor c d) (NonEmptyCursor (TreeCursor a b) (CTree b)) (NonEmptyCursor (TreeCursor c d) (CTree d))+forestCursorListCursorL =+ lens forestCursorListCursor $ \fc lc -> fc {forestCursorListCursor = lc}++forestCursorSelectedTreeL :: Lens' (ForestCursor a b) (TreeCursor a b)+forestCursorSelectedTreeL = forestCursorListCursorL . nonEmptyCursorElemL++forestCursorSelectPrevTreeCursor ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectPrevTreeCursor f g =+ forestCursorListCursorL $+ nonEmptyCursorSelectPrev (rebuildTreeCursor f) (makeTreeCursor g)++forestCursorSelectNextTreeCursor ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectNextTreeCursor f g =+ forestCursorListCursorL $+ nonEmptyCursorSelectNext (rebuildTreeCursor f) (makeTreeCursor g)++forestCursorSelectFirstTreeCursor ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b+forestCursorSelectFirstTreeCursor f g =+ forestCursorListCursorL %~+ (nonEmptyCursorSelectFirst (rebuildTreeCursor f) (makeTreeCursor g))++forestCursorSelectLastTreeCursor ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b+forestCursorSelectLastTreeCursor f g =+ forestCursorListCursorL %~+ (nonEmptyCursorSelectLast (rebuildTreeCursor f) (makeTreeCursor g))++forestCursorSelectNext ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectNext f g fc =+ (fc & forestCursorSelectedTreeL (treeCursorSelectNext f g)) <|>+ forestCursorSelectNextTreeCursor f g fc++forestCursorSelectPrev ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectPrev f g fc =+ (fc & forestCursorSelectedTreeL (treeCursorSelectPrev f g)) <|>+ (forestCursorSelectPrevTreeCursor f g fc >>=+ forestCursorSelectedTreeL (treeCursorSelectBelowAtEndRecursively f g)) <|>+ (forestCursorSelectPrevTreeCursor f g fc)++forestCursorSelectNextOnSameLevel ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectNextOnSameLevel f g fc =+ (fc & forestCursorSelectedTreeL (treeCursorSelectNextOnSameLevel f g)) <|>+ forestCursorSelectNextTreeCursor f g fc++forestCursorSelectPrevOnSameLevel ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectPrevOnSameLevel f g fc =+ (fc & forestCursorSelectedTreeL (treeCursorSelectPrevOnSameLevel f g)) <|>+ forestCursorSelectPrevTreeCursor f g fc++forestCursorSelectFirst ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b+forestCursorSelectFirst f g fc =+ case forestCursorSelectPrevTreeCursor f g fc of+ Just fc' -> forestCursorSelectFirst f g fc'+ Nothing ->+ case forestCursorSelectPrev f g fc of+ Just fc' -> forestCursorSelectFirst f g fc'+ Nothing -> fc++forestCursorSelectLast ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b+forestCursorSelectLast f g fc =+ case forestCursorSelectNextTreeCursor f g fc of+ Just fc' -> forestCursorSelectLast f g fc'+ Nothing ->+ case forestCursorSelectNext f g fc of+ Just fc' -> forestCursorSelectLast f g fc'+ Nothing -> fc++forestCursorSelectBelowAtPos ::+ (a -> b)+ -> (b -> a)+ -> Int+ -> ForestCursor a b+ -> Maybe (ForestCursor a b)+forestCursorSelectBelowAtPos f g i =+ forestCursorSelectedTreeL $ treeCursorSelectBelowAtPos f g i++forestCursorSelectBelowAtStart ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectBelowAtStart f g =+ forestCursorSelectedTreeL $ treeCursorSelectBelowAtStart f g++forestCursorSelectBelowAtEnd ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSelectBelowAtEnd f g =+ forestCursorSelectedTreeL $ treeCursorSelectBelowAtEnd f g++forestCursorSelection :: ForestCursor a b -> Int+forestCursorSelection fc =+ nonEmptyCursorSelection $ fc ^. forestCursorListCursorL++forestCursorSelectIndex ::+ (a -> b)+ -> (b -> a)+ -> Int+ -> ForestCursor a b+ -> Maybe (ForestCursor a b)+forestCursorSelectIndex f g i =+ forestCursorListCursorL+ (nonEmptyCursorSelectIndex (rebuildTreeCursor f) (makeTreeCursor g) i)++forestCursorOpenCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorOpenCurrentForest =+ forestCursorSelectedTreeL treeCursorOpenCurrentForest++forestCursorCloseCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorCloseCurrentForest =+ forestCursorSelectedTreeL treeCursorCloseCurrentForest++forestCursorToggleCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorToggleCurrentForest =+ forestCursorSelectedTreeL treeCursorToggleCurrentForest++forestCursorInsertEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorInsertEntireTree t =+ forestCursorListCursorL %~ nonEmptyCursorInsert (makeCTree t)++forestCursorInsertAndSelectTreeCursor ::+ (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b+forestCursorInsertAndSelectTreeCursor f tc =+ forestCursorListCursorL %~+ nonEmptyCursorInsertAndSelect (rebuildTreeCursor f) tc++forestCursorAppendEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorAppendEntireTree t =+ forestCursorListCursorL %~ nonEmptyCursorAppend (makeCTree t)++forestCursorAppendAndSelectTreeCursor ::+ (a -> b) -> TreeCursor a b -> ForestCursor a b -> ForestCursor a b+forestCursorAppendAndSelectTreeCursor f tc =+ forestCursorListCursorL %~+ nonEmptyCursorAppendAndSelect (rebuildTreeCursor f) tc++forestCursorInsertTree :: Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorInsertTree t fc =+ fromMaybe (forestCursorInsertEntireTree t fc) $+ fc & forestCursorSelectedTreeL (treeCursorInsert t)++forestCursorInsertAndSelectTree ::+ (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorInsertAndSelectTree f g t fc =+ fromMaybe+ (forestCursorInsertAndSelectTreeCursor+ f+ (makeTreeCursor g $ makeCTree t)+ fc) $+ fc & forestCursorSelectedTreeL (treeCursorInsertAndSelect f g t)++forestCursorAppendTree :: Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorAppendTree t fc =+ fromMaybe (forestCursorAppendEntireTree t fc) $+ fc & forestCursorSelectedTreeL (treeCursorAppend t)++forestCursorAppendAndSelectTree ::+ (a -> b) -> (b -> a) -> Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorAppendAndSelectTree f g t fc =+ fromMaybe+ (forestCursorAppendAndSelectTreeCursor+ f+ (makeTreeCursor g $ makeCTree t)+ fc) $+ fc & forestCursorSelectedTreeL (treeCursorAppendAndSelect f g t)++forestCursorInsert :: b -> ForestCursor a b -> ForestCursor a b+forestCursorInsert b = forestCursorInsertTree $ Node b []++forestCursorInsertAndSelect ::+ (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b+forestCursorInsertAndSelect f g b =+ forestCursorInsertAndSelectTree f g $ Node b []++forestCursorAppend :: b -> ForestCursor a b -> ForestCursor a b+forestCursorAppend b = forestCursorAppendTree $ Node b []++forestCursorAppendAndSelect ::+ (a -> b) -> (b -> a) -> b -> ForestCursor a b -> ForestCursor a b+forestCursorAppendAndSelect f g b =+ forestCursorAppendAndSelectTree f g $ Node b []++forestCursorAddChildTreeToNodeAtPos ::+ Int -> Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorAddChildTreeToNodeAtPos i t =+ forestCursorSelectedTreeL %~ treeCursorAddChildAtPos i t++forestCursorAddChildTreeToNodeAtStart ::+ Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorAddChildTreeToNodeAtStart t =+ forestCursorSelectedTreeL %~ treeCursorAddChildAtStart t++forestCursorAddChildTreeToNodeAtEnd ::+ Tree b -> ForestCursor a b -> ForestCursor a b+forestCursorAddChildTreeToNodeAtEnd t fc =+ fc & forestCursorSelectedTreeL %~ treeCursorAddChildAtEnd t++forestCursorAddChildToNodeAtPos ::+ Int -> b -> ForestCursor a b -> ForestCursor a b+forestCursorAddChildToNodeAtPos i b =+ forestCursorAddChildTreeToNodeAtPos i $ Node b []++forestCursorAddChildToNodeAtStart :: b -> ForestCursor a b -> ForestCursor a b+forestCursorAddChildToNodeAtStart b =+ forestCursorAddChildTreeToNodeAtStart $ Node b []++forestCursorAddChildToNodeAtEnd :: b -> ForestCursor a b -> ForestCursor a b+forestCursorAddChildToNodeAtEnd b =+ forestCursorAddChildTreeToNodeAtEnd $ Node b []++forestCursorRemoveElemAndSelectPrev ::+ (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))+forestCursorRemoveElemAndSelectPrev g fc =+ case (fc &+ focusPossibleDeleteOrUpdate+ forestCursorSelectedTreeL+ (treeCursorDeleteElemAndSelectPrevious g)) of+ Just Deleted ->+ (fc &+ focusPossibleDeleteOrUpdate+ forestCursorListCursorL+ (nonEmptyCursorRemoveElemAndSelectPrev (makeTreeCursor g)))+ r -> r++forestCursorDeleteElemAndSelectNext ::+ (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))+forestCursorDeleteElemAndSelectNext g fc =+ case (fc &+ focusPossibleDeleteOrUpdate+ forestCursorSelectedTreeL+ (treeCursorDeleteElemAndSelectNext g)) of+ Just Deleted ->+ (fc &+ focusPossibleDeleteOrUpdate+ forestCursorListCursorL+ (nonEmptyCursorDeleteElemAndSelectNext (makeTreeCursor g)))+ r -> r++forestCursorRemoveElem ::+ (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)+forestCursorRemoveElem g fc =+ (fc & forestCursorSelectedTreeL (treeCursorRemoveElem g)) <|>+ (fc & forestCursorListCursorL (nonEmptyCursorRemoveElem (makeTreeCursor g)))++forestCursorDeleteElem ::+ (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)+forestCursorDeleteElem g fc =+ (fc & forestCursorSelectedTreeL (treeCursorDeleteElem g)) <|>+ (fc & forestCursorListCursorL (nonEmptyCursorDeleteElem (makeTreeCursor g)))++forestCursorRemoveSubTreeAndSelectPrev ::+ (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))+forestCursorRemoveSubTreeAndSelectPrev g fc =+ joinPossibleDeletes+ (fc &+ focusPossibleDeleteOrUpdate+ forestCursorSelectedTreeL+ (treeCursorDeleteSubTreeAndSelectPrevious g))+ (fc &+ focusPossibleDeleteOrUpdate+ forestCursorListCursorL+ (nonEmptyCursorRemoveElemAndSelectPrev (makeTreeCursor g)))++forestCursorDeleteSubTreeAndSelectNext ::+ (b -> a) -> ForestCursor a b -> Maybe (DeleteOrUpdate (ForestCursor a b))+forestCursorDeleteSubTreeAndSelectNext g fc =+ joinPossibleDeletes+ (fc &+ focusPossibleDeleteOrUpdate+ forestCursorSelectedTreeL+ (treeCursorDeleteSubTreeAndSelectNext g))+ (fc &+ focusPossibleDeleteOrUpdate+ forestCursorListCursorL+ (nonEmptyCursorDeleteElemAndSelectNext (makeTreeCursor g)))++forestCursorRemoveSubTree ::+ (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)+forestCursorRemoveSubTree g fc =+ (fc & forestCursorSelectedTreeL (treeCursorRemoveSubTree g)) <|>+ (fc & forestCursorListCursorL (nonEmptyCursorRemoveElem (makeTreeCursor g)))++forestCursorDeleteSubTree ::+ (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b)+forestCursorDeleteSubTree g fc =+ (fc & forestCursorSelectedTreeL (treeCursorDeleteSubTree g)) <|>+ (fc & forestCursorListCursorL (nonEmptyCursorDeleteElem (makeTreeCursor g)))++forestCursorAddRoot ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> a -> TreeCursor a b+forestCursorAddRoot f g fc v =+ makeTreeCursor g $ CNode (f v) $ OpenForest $ rebuildForestCursor f fc++-- | Swaps the current node with the previous node on the same level+--+-- Example:+--+-- Before:+--+-- > - a+-- > - b <--+--+-- After:+--+-- > - b <--+-- > - a+forestCursorSwapPrev :: ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSwapPrev fc@(ForestCursor ne) =+ case fc & forestCursorSelectedTreeL treeCursorSwapPrev of+ Swapped fc' -> pure fc'+ NoSiblingsToSwapWith -> Nothing+ SwapperIsTopNode ->+ case nonEmptyCursorPrev ne of+ [] -> Nothing+ (t:ts) ->+ pure $+ ForestCursor+ ne+ { nonEmptyCursorPrev = ts+ , nonEmptyCursorNext = t : nonEmptyCursorNext ne+ }++-- | Swaps the current node with the next node on the same level+--+-- Example:+--+-- Before:+--+-- > - a <--+-- > - b+--+-- After:+--+-- > - b+-- > - a <--+forestCursorSwapNext :: ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorSwapNext fc@(ForestCursor ne) =+ case fc & forestCursorSelectedTreeL treeCursorSwapNext of+ Swapped fc' -> pure fc'+ NoSiblingsToSwapWith -> Nothing+ SwapperIsTopNode ->+ case nonEmptyCursorNext ne of+ [] -> Nothing+ (t:ts) ->+ pure $+ ForestCursor+ ne+ { nonEmptyCursorPrev = t : nonEmptyCursorPrev ne+ , nonEmptyCursorNext = ts+ }++-- | Promotes the current node to the level of its parent.+--+-- Example:+--+-- Before:+--+-- > - a+-- > |- b+-- > | |- c+-- > |- d <--+-- > | |- e+-- > |- f+-- > |- g+-- > - h+--+-- After:+--+-- > - a+-- > |- b+-- > | |- c+-- > | |- e+-- > |- f+-- > |- g+-- > - d <--+-- > - h+forestCursorPromoteElem ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorPromoteElem f g fc@(ForestCursor ne) =+ case fc & forestCursorSelectedTreeL (treeCursorPromoteElem f g) of+ PromotedElem fc' -> pure fc'+ CannotPromoteTopElem -> Nothing+ NoSiblingsToAdoptChildren -> Nothing+ NoGrandparentToPromoteElemUnder -> do+ let tc = fc ^. forestCursorSelectedTreeL+ ta <- treeAbove tc+ lefts <-+ case (treeBelow tc) of+ EmptyCForest -> pure $ treeAboveLefts ta+ _ ->+ case treeAboveLefts ta of+ [] -> Nothing+ (CNode t ls:ts) ->+ pure $+ CNode+ t+ (openForest $+ unpackCForest ls +++ unpackCForest (treeBelow tc)) :+ ts+ let ta' = ta {treeAboveLefts = lefts}+ let tc' = tc {treeAbove = Just ta'}+ tc'' <-+ case treeCursorDeleteSubTree g tc' of+ Deleted -> Nothing -- Cannot happen, otherwise we would have gotten 'CannotPromoteTopNode'.+ Updated tc'' -> pure tc''+ pure $+ ForestCursor $+ ne+ { nonEmptyCursorPrev =+ rebuildTreeCursor f tc'' : nonEmptyCursorPrev ne+ , nonEmptyCursorCurrent =+ singletonTreeCursor $+ treeCurrent $ fc ^. forestCursorSelectedTreeL+ }++-- | Promotes the current node to the level of its parent.+--+-- Example:+--+-- Before:+--+-- > - a+-- > |- b+-- > | |- c+-- > |- d <--+-- > | |- e+-- > |- f+-- > |- g+-- > - h+--+-- After:+--+-- >+-- > - a+-- > |- b+-- > | |- c+-- > |- f+-- > |- g+-- > - d <--+-- > |- e+-- > - h+forestCursorPromoteSubTree ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorPromoteSubTree f g fc@(ForestCursor ne) =+ case fc & forestCursorSelectedTreeL (treeCursorPromoteSubTree f g) of+ Promoted fc' -> pure fc'+ CannotPromoteTopNode -> Nothing+ NoGrandparentToPromoteUnder ->+ case treeCursorDeleteSubTree g $ fc ^. forestCursorSelectedTreeL of+ Deleted -> Nothing -- Cannot happen, otherwise we would have gotten 'CannotPromoteTopNode'.+ Updated tc' ->+ pure $+ ForestCursor $+ ne+ { nonEmptyCursorPrev =+ rebuildTreeCursor f tc' : nonEmptyCursorPrev ne+ , nonEmptyCursorCurrent =+ (fc ^. forestCursorSelectedTreeL)+ {treeAbove = Nothing}+ }++-- | Demotes the current node to the level of its children.+--+-- Example:+--+-- Before:+--+-- > - a+-- > |- b+-- > - c <--+-- > |- d+-- > - e+--+-- After:+--+-- > - a+-- > |- b+-- > |- c <--+-- > |- d+-- > - e+forestCursorDemoteElem ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorDemoteElem f g fc@(ForestCursor ne) =+ case (fc & forestCursorSelectedTreeL (treeCursorDemoteElem f g)) of+ Demoted fc' -> pure fc'+ CannotDemoteTopNode ->+ case nonEmptyCursorPrev ne of+ [] -> Nothing+ (CNode v vts:ts) -> do+ let CNode v' vts' =+ rebuildTreeCursor+ f+ (fc ^. forestCursorSelectedTreeL)+ let n' =+ CNode v $+ openForest $+ unpackCForest vts +++ (CNode v' emptyCForest) : unpackCForest vts'+ tc <-+ makeTreeCursorWithSelection+ f+ g+ (SelectChild (lengthCForest vts) SelectNode)+ n'+ pure $+ ForestCursor+ ne+ { nonEmptyCursorPrev = ts+ , nonEmptyCursorCurrent = tc+ }+ NoSiblingsToDemoteUnder -> Nothing++-- | Demotes the current subtree to the level of its children.+--+-- Example:+--+-- Before:+--+-- > - a+-- > |- b+-- > - c <--+-- > |- d+--+-- After:+--+-- > - a+-- > |- b+-- > |- c <--+-- > |- d+forestCursorDemoteSubTree ::+ (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b)+forestCursorDemoteSubTree f g fc@(ForestCursor ne) =+ case fc & forestCursorSelectedTreeL (treeCursorDemoteSubTree f g) of+ Demoted fc' -> pure fc'+ CannotDemoteTopNode ->+ case nonEmptyCursorPrev ne of+ [] -> Nothing+ (CNode v vts:ts) -> do+ let n' =+ CNode v $+ openForest $+ unpackCForest vts +++ [ rebuildTreeCursor+ f+ (fc ^. forestCursorSelectedTreeL)+ ]+ tc <-+ makeTreeCursorWithSelection+ f+ g+ (SelectChild (lengthCForest vts) SelectNode)+ n'+ pure $+ ForestCursor+ ne+ { nonEmptyCursorPrev = ts+ , nonEmptyCursorCurrent = tc+ }+ NoSiblingsToDemoteUnder -> Nothing++-- | Demotes the current node to the level of its children, by adding two roots.+-- One for the current node and one for its children that are left behind.+--+-- Example:+--+-- Before:+--+-- > - a <--+-- > |- b+--+-- After:+--+-- > - <given element 1>+-- > |- a <--+-- > - <given element 2>+-- > |- b+forestCursorDemoteElemUnder :: b -> b -> ForestCursor a b -> ForestCursor a b+forestCursorDemoteElemUnder b1 b2 fc@(ForestCursor ne) =+ case fc & forestCursorSelectedTreeL (treeCursorDemoteElemUnder b1 b2) of+ Just fc' -> fc'+ Nothing ->+ let t = fc ^. forestCursorSelectedTreeL+ in ForestCursor $+ ne+ { nonEmptyCursorCurrent =+ TreeCursor+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts = []+ , treeAboveAbove = Nothing+ , treeAboveNode = b1+ , treeAboveRights = []+ }+ , treeCurrent = treeCurrent t+ , treeBelow = emptyCForest+ }+ , nonEmptyCursorNext =+ CNode b2 (treeBelow t) : nonEmptyCursorNext ne+ }++-- | Demotes the current subtree to the level of its children, by adding a root.+--+-- Example:+--+-- Before:+--+-- > a <--+-- > |- b+--+-- After:+--+-- > <given element>+-- > |- a <--+-- > |- b+forestCursorDemoteSubTreeUnder :: b -> ForestCursor a b -> ForestCursor a b+forestCursorDemoteSubTreeUnder b =+ forestCursorSelectedTreeL %~ treeCursorDemoteSubTreeUnder b
+ src/Cursor/List.hs view
@@ -0,0 +1,151 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.List+ ( ListCursor(..)+ , emptyListCursor+ , makeListCursor+ , makeListCursorWithSelection+ , rebuildListCursor+ , listCursorNull+ , listCursorLength+ , listCursorIndex+ , listCursorSelectPrev+ , listCursorSelectNext+ , listCursorSelectIndex+ , listCursorSelectStart+ , listCursorSelectEnd+ , listCursorPrevItem+ , listCursorNextItem+ , listCursorInsert+ , listCursorAppend+ , listCursorRemove+ , listCursorDelete+ , listCursorSplit+ , listCursorCombine+ ) where++import GHC.Generics (Generic)++import Data.Validity++data ListCursor a = ListCursor+ { listCursorPrev :: [a] -- ^ In reverse order+ , listCursorNext :: [a]+ } deriving (Show, Eq, Generic, Functor)++instance Validity a => Validity (ListCursor a)++emptyListCursor :: ListCursor a+emptyListCursor = ListCursor {listCursorPrev = [], listCursorNext = []}++makeListCursor :: [a] -> ListCursor a+makeListCursor as = ListCursor {listCursorPrev = [], listCursorNext = as}++makeListCursorWithSelection :: Int -> [a] -> Maybe (ListCursor a)+makeListCursorWithSelection i as+ | i < 0 = Nothing+ | i > length as = Nothing+ | otherwise =+ Just+ ListCursor+ { listCursorPrev = reverse $ take i as+ , listCursorNext = drop i as+ }++rebuildListCursor :: ListCursor a -> [a]+rebuildListCursor ListCursor {..} = reverse listCursorPrev ++ listCursorNext++listCursorNull :: ListCursor a -> Bool+listCursorNull ListCursor {..} = null listCursorPrev && null listCursorNext++listCursorLength :: ListCursor a -> Int+listCursorLength = length . rebuildListCursor++listCursorIndex :: ListCursor a -> Int+listCursorIndex = length . listCursorPrev++listCursorSelectPrev :: ListCursor a -> Maybe (ListCursor a)+listCursorSelectPrev tc =+ case listCursorPrev tc of+ [] -> Nothing+ (c:cs) ->+ Just+ ListCursor+ { listCursorPrev = cs+ , listCursorNext = c : listCursorNext tc+ }++listCursorSelectNext :: ListCursor a -> Maybe (ListCursor a)+listCursorSelectNext tc =+ case listCursorNext tc of+ [] -> Nothing+ (c:cs) ->+ Just+ ListCursor+ { listCursorPrev = c : listCursorPrev tc+ , listCursorNext = cs+ }++listCursorSelectIndex :: Int -> ListCursor a -> ListCursor a+listCursorSelectIndex ix_ lc =+ let ls = rebuildListCursor lc+ in case splitAt ix_ ls of+ (l, r) ->+ ListCursor {listCursorPrev = reverse l, listCursorNext = r}++listCursorSelectStart :: ListCursor a -> ListCursor a+listCursorSelectStart tc =+ case listCursorSelectPrev tc of+ Nothing -> tc+ Just tc' -> listCursorSelectStart tc'++listCursorSelectEnd :: ListCursor a -> ListCursor a+listCursorSelectEnd tc =+ case listCursorSelectNext tc of+ Nothing -> tc+ Just tc' -> listCursorSelectEnd tc'++listCursorPrevItem :: ListCursor a -> Maybe a+listCursorPrevItem lc =+ case listCursorPrev lc of+ [] -> Nothing+ (c:_) -> Just c++listCursorNextItem :: ListCursor a -> Maybe a+listCursorNextItem lc =+ case listCursorNext lc of+ [] -> Nothing+ (c:_) -> Just c++listCursorInsert :: a -> ListCursor a -> ListCursor a+listCursorInsert c lc = lc {listCursorPrev = c : listCursorPrev lc}++listCursorAppend :: a -> ListCursor a -> ListCursor a+listCursorAppend c lc = lc {listCursorNext = c : listCursorNext lc}++listCursorRemove :: ListCursor a -> Maybe (ListCursor a)+listCursorRemove tc =+ case listCursorPrev tc of+ [] -> Nothing+ (_:prev) -> Just $ tc {listCursorPrev = prev}++listCursorDelete :: ListCursor a -> Maybe (ListCursor a)+listCursorDelete tc =+ case listCursorNext tc of+ [] -> Nothing+ (_:next) -> Just $ tc {listCursorNext = next}++listCursorSplit :: ListCursor a -> (ListCursor a, ListCursor a)+listCursorSplit ListCursor {..} =+ ( ListCursor {listCursorPrev = listCursorPrev, listCursorNext = []}+ , ListCursor {listCursorPrev = [], listCursorNext = listCursorNext})++listCursorCombine :: ListCursor a -> ListCursor a -> ListCursor a+listCursorCombine lc1 lc2 =+ ListCursor+ { listCursorPrev = reverse $ rebuildListCursor lc1+ , listCursorNext = rebuildListCursor lc2+ }
+ src/Cursor/List/NonEmpty.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.List.NonEmpty+ ( NonEmptyCursor(..)+ , makeNonEmptyCursor+ , makeNonEmptyCursorWithSelection+ , singletonNonEmptyCursor+ , rebuildNonEmptyCursor+ , nonEmptyCursorElemL+ , mapNonEmptyCursor+ , nonEmptyCursorSelectPrev+ , nonEmptyCursorSelectNext+ , nonEmptyCursorSelectFirst+ , nonEmptyCursorSelectLast+ , nonEmptyCursorSelection+ , nonEmptyCursorSelectIndex+ , nonEmptyCursorInsert+ , nonEmptyCursorAppend+ , nonEmptyCursorInsertAndSelect+ , nonEmptyCursorAppendAndSelect+ , nonEmptyCursorInsertAtStart+ , nonEmptyCursorAppendAtEnd+ , nonEmptyCursorInsertAtStartAndSelect+ , nonEmptyCursorAppendAtEndAndSelect+ , nonEmptyCursorRemoveElemAndSelectPrev+ , nonEmptyCursorDeleteElemAndSelectNext+ , nonEmptyCursorRemoveElem+ , nonEmptyCursorDeleteElem+ , nonEmptyCursorSearch+ , nonEmptyCursorSelectOrAdd+ , nonemptyPrepend+ , nonemptyAppend+ ) where++import GHC.Generics (Generic)++import Data.Validity++import Data.Maybe++import Control.Monad++import Lens.Micro++import Data.List.NonEmpty (NonEmpty(..), (<|))+import qualified Data.List.NonEmpty as NE++import Cursor.Types++-- | A 'nonempty list' cursor+data NonEmptyCursor a b = NonEmptyCursor+ { nonEmptyCursorPrev :: [b] -- In reverse order+ , nonEmptyCursorCurrent :: a+ , nonEmptyCursorNext :: [b]+ } deriving (Show, Eq, Generic, Functor)++instance (Validity a, Validity b) => Validity (NonEmptyCursor a b)++makeNonEmptyCursor :: (b -> a) -> NonEmpty b -> NonEmptyCursor a b+makeNonEmptyCursor g = fromJust . makeNonEmptyCursorWithSelection g 0++makeNonEmptyCursorWithSelection ::+ (b -> a) -> Int -> NonEmpty b -> Maybe (NonEmptyCursor a b)+makeNonEmptyCursorWithSelection g i ne = do+ (l, m, r) <- applyNonEmptySelection ne i+ pure+ NonEmptyCursor+ { nonEmptyCursorPrev = reverse l+ , nonEmptyCursorCurrent = g m+ , nonEmptyCursorNext = r+ }+ where+ applyNonEmptySelection :: NonEmpty a -> Int -> Maybe ([a], a, [a])+ applyNonEmptySelection (c :| rest) i_+ | i_ < 0 = Nothing+ | i_ == 0 = Just ([], c, rest)+ | otherwise = do+ ne_ <- NE.nonEmpty rest+ (l, m, r) <- applyNonEmptySelection ne_ (i_ - 1)+ pure (c : l, m, r)++singletonNonEmptyCursor :: a -> NonEmptyCursor a b+singletonNonEmptyCursor a =+ NonEmptyCursor+ { nonEmptyCursorPrev = []+ , nonEmptyCursorCurrent = a+ , nonEmptyCursorNext = []+ }++rebuildNonEmptyCursor :: (a -> b) -> NonEmptyCursor a b -> NonEmpty b+rebuildNonEmptyCursor f NonEmptyCursor {..} =+ nonemptyPrepend (reverse nonEmptyCursorPrev) $+ f nonEmptyCursorCurrent :| nonEmptyCursorNext++mapNonEmptyCursor ::+ (a -> c) -> (b -> d) -> NonEmptyCursor a b -> NonEmptyCursor c d+mapNonEmptyCursor f g NonEmptyCursor {..} =+ NonEmptyCursor+ { nonEmptyCursorPrev = map g nonEmptyCursorPrev+ , nonEmptyCursorCurrent = f nonEmptyCursorCurrent+ , nonEmptyCursorNext = map g nonEmptyCursorNext+ }++nonEmptyCursorElemL :: Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b+nonEmptyCursorElemL =+ lens nonEmptyCursorCurrent $ \lec le -> lec {nonEmptyCursorCurrent = le}++nonEmptyCursorSelectPrev ::+ (a -> b) -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)+nonEmptyCursorSelectPrev f g lec =+ case nonEmptyCursorPrev lec of+ [] -> Nothing+ (e:rest) ->+ Just $+ lec+ { nonEmptyCursorPrev = rest+ , nonEmptyCursorCurrent = g e+ , nonEmptyCursorNext =+ f (nonEmptyCursorCurrent lec) : nonEmptyCursorNext lec+ }++nonEmptyCursorSelectNext ::+ (a -> b) -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b)+nonEmptyCursorSelectNext f g lec =+ case nonEmptyCursorNext lec of+ [] -> Nothing+ (e:rest) ->+ Just $+ lec+ { nonEmptyCursorPrev =+ f (nonEmptyCursorCurrent lec) : nonEmptyCursorPrev lec+ , nonEmptyCursorCurrent = g e+ , nonEmptyCursorNext = rest+ }++nonEmptyCursorSelectFirst ::+ (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorSelectFirst f g lec =+ case nonEmptyCursorSelectPrev f g lec of+ Nothing -> lec+ Just lec' -> nonEmptyCursorSelectFirst f g lec'++nonEmptyCursorSelectLast ::+ (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorSelectLast f g lec =+ case nonEmptyCursorSelectNext f g lec of+ Nothing -> lec+ Just lec' -> nonEmptyCursorSelectLast f g lec'++nonEmptyCursorSelection :: NonEmptyCursor a b -> Int+nonEmptyCursorSelection = length . nonEmptyCursorPrev++nonEmptyCursorSelectIndex ::+ (a -> b)+ -> (b -> a)+ -> Int+ -> NonEmptyCursor a b+ -> Maybe (NonEmptyCursor a b)+nonEmptyCursorSelectIndex f g i nec+ | i < nonEmptyCursorSelection nec =+ nonEmptyCursorSelectPrev f g nec >>= nonEmptyCursorSelectIndex f g i+ | i > nonEmptyCursorSelection nec =+ nonEmptyCursorSelectNext f g nec >>= nonEmptyCursorSelectIndex f g i+ | otherwise = Just nec++nonEmptyCursorInsert :: b -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorInsert c lec =+ lec {nonEmptyCursorPrev = c : nonEmptyCursorPrev lec}++nonEmptyCursorAppend :: b -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorAppend c lec =+ lec {nonEmptyCursorNext = c : nonEmptyCursorNext lec}++nonEmptyCursorInsertAndSelect ::+ (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorInsertAndSelect f c lec =+ lec+ { nonEmptyCursorCurrent = c+ , nonEmptyCursorNext =+ f (nonEmptyCursorCurrent lec) : nonEmptyCursorNext lec+ }++nonEmptyCursorAppendAndSelect ::+ (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorAppendAndSelect f c lec =+ lec+ { nonEmptyCursorCurrent = c+ , nonEmptyCursorPrev =+ f (nonEmptyCursorCurrent lec) : nonEmptyCursorPrev lec+ }++nonEmptyCursorInsertAtStart :: b -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorInsertAtStart c lec =+ lec {nonEmptyCursorPrev = nonEmptyCursorPrev lec ++ [c]}++nonEmptyCursorAppendAtEnd :: b -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorAppendAtEnd c lec =+ lec {nonEmptyCursorNext = nonEmptyCursorNext lec ++ [c]}++nonEmptyCursorInsertAtStartAndSelect ::+ (a -> b) -> (b -> a) -> b -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorInsertAtStartAndSelect f g c =+ nonEmptyCursorSelectFirst f g . nonEmptyCursorInsertAtStart c++nonEmptyCursorAppendAtEndAndSelect ::+ (a -> b) -> (b -> a) -> b -> NonEmptyCursor a b -> NonEmptyCursor a b+nonEmptyCursorAppendAtEndAndSelect f g c =+ nonEmptyCursorSelectLast f g . nonEmptyCursorAppendAtEnd c++nonEmptyCursorRemoveElemAndSelectPrev ::+ (b -> a)+ -> NonEmptyCursor a b+ -> Maybe (DeleteOrUpdate (NonEmptyCursor a b))+nonEmptyCursorRemoveElemAndSelectPrev g lec =+ case nonEmptyCursorPrev lec of+ [] ->+ case nonEmptyCursorNext lec of+ [] -> Just Deleted+ _ -> Nothing+ (e:rest) ->+ Just $+ Updated $+ lec {nonEmptyCursorPrev = rest, nonEmptyCursorCurrent = g e}++-- the first maybe: whether the operation succeeded+-- the second maybe: whether the list is still nonempty+nonEmptyCursorDeleteElemAndSelectNext ::+ (b -> a)+ -> NonEmptyCursor a b+ -> Maybe (DeleteOrUpdate (NonEmptyCursor a b))+nonEmptyCursorDeleteElemAndSelectNext g lec =+ case nonEmptyCursorNext lec of+ [] ->+ case nonEmptyCursorPrev lec of+ [] -> Just Deleted+ _ -> Nothing+ (e:rest) ->+ Just $+ Updated $+ lec {nonEmptyCursorCurrent = g e, nonEmptyCursorNext = rest}++nonEmptyCursorRemoveElem ::+ (b -> a) -> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)+nonEmptyCursorRemoveElem g lec =+ joinDeletes+ (nonEmptyCursorRemoveElemAndSelectPrev g lec)+ (nonEmptyCursorDeleteElemAndSelectNext g lec)++nonEmptyCursorDeleteElem ::+ (b -> a) -> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b)+nonEmptyCursorDeleteElem g lec =+ joinDeletes+ (nonEmptyCursorDeleteElemAndSelectNext g lec)+ (nonEmptyCursorRemoveElemAndSelectPrev g lec)++nonEmptyCursorSearch ::+ (a -> b)+ -> (b -> a)+ -> (a -> Bool)+ -> NonEmptyCursor a b+ -> Maybe (NonEmptyCursor a b)+nonEmptyCursorSearch f g p nec =+ if p $ nonEmptyCursorCurrent nec+ then Just nec+ else lookPrev nec `mplus` lookNext nec+ where+ lookPrev = look nonEmptyCursorSelectPrev+ lookNext = look nonEmptyCursorSelectNext+ look func nec_ = do+ nec' <- func f g nec_+ if p $ nonEmptyCursorCurrent nec'+ then Just nec'+ else look func nec'++nonEmptyCursorSelectOrAdd ::+ (a -> b)+ -> (b -> a)+ -> (a -> Bool)+ -> a+ -> NonEmptyCursor a b+ -> NonEmptyCursor a b+nonEmptyCursorSelectOrAdd f g p a nec =+ case nonEmptyCursorSearch f g p nec of+ Nothing -> nonEmptyCursorAppendAndSelect f a nec+ Just nec' -> nec'++nonemptyPrepend :: [a] -> NonEmpty a -> NonEmpty a+nonemptyPrepend ls ne = foldr (<|) ne ls++nonemptyAppend :: NonEmpty a -> [a] -> NonEmpty a+nonemptyAppend (x :| xs) ls = x :| (xs ++ ls)
+ src/Cursor/Map.hs view
@@ -0,0 +1,287 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.Map+ ( MapCursor(..)+ , makeMapCursor+ , makeMapCursorWithSelection+ , singletonMapCursorKey+ , singletonMapCursorValue+ , rebuildMapCursor+ , mapMapCursor+ , mapCursorNonEmptyCursorL+ , mapCursorElemL+ , mapCursorSelectKey+ , mapCursorSelectValue+ , mapCursorToggleSelected+ , mapCursorSelectPrev+ , mapCursorSelectNext+ , mapCursorSelectFirst+ , mapCursorSelectLast+ , mapCursorSelection+ , mapCursorSelectIndex+ , mapCursorInsert+ , mapCursorAppend+ , mapCursorInsertAndSelectKey+ , mapCursorAppendAndSelectKey+ , mapCursorInsertAndSelectValue+ , mapCursorAppendAndSelectValue+ , mapCursorRemoveElemAndSelectPrev+ , mapCursorDeleteElemAndSelectNext+ , mapCursorRemoveElem+ , mapCursorDeleteElem+ , mapCursorSearch+ , mapCursorSelectOrAdd+ , module Cursor.Map.KeyValue+ ) where++import GHC.Generics (Generic)++import Data.Validity+import Data.Validity.Tree ()++import Data.List.NonEmpty (NonEmpty(..))+import Data.Maybe++import Lens.Micro++import Cursor.List.NonEmpty+import Cursor.Map.KeyValue+import Cursor.Types++newtype MapCursor kc vc k v = MapCursor+ { mapCursorList :: NonEmptyCursor (KeyValueCursor kc vc k v) (k, v)+ } deriving (Show, Eq, Generic)++instance (Validity kc, Validity vc, Validity k, Validity v) =>+ Validity (MapCursor kc vc k v)++makeMapCursor :: (k -> kc) -> NonEmpty (k, v) -> MapCursor kc vc k v+makeMapCursor h = fromJust . makeMapCursorWithSelection h 0++makeMapCursorWithSelection ::+ (k -> kc) -> Int -> NonEmpty (k, v) -> Maybe (MapCursor kc vc k v)+makeMapCursorWithSelection h i ne =+ MapCursor <$>+ makeNonEmptyCursorWithSelection+ (\(k, v) -> makeKeyValueCursorKey (h k) v)+ i+ ne++singletonMapCursorKey :: kc -> v -> MapCursor kc vc k v+singletonMapCursorKey kc v =+ MapCursor+ {mapCursorList = singletonNonEmptyCursor $ makeKeyValueCursorKey kc v}++singletonMapCursorValue :: k -> vc -> MapCursor kc vc k v+singletonMapCursorValue k vc =+ MapCursor+ {mapCursorList = singletonNonEmptyCursor $ makeKeyValueCursorValue k vc}++rebuildMapCursor ::+ (kc -> k) -> (vc -> v) -> MapCursor kc vc k v -> NonEmpty (k, v)+rebuildMapCursor f g =+ rebuildNonEmptyCursor (rebuildKeyValueCursor f g) . mapCursorList++mapMapCursor ::+ (kc -> lc)+ -> (vc -> wc)+ -> (k -> l)+ -> (v -> w)+ -> MapCursor kc vc k v+ -> MapCursor lc wc l w+mapMapCursor a b c d =+ mapCursorNonEmptyCursorL %~+ mapNonEmptyCursor (mapKeyValueCursor a b c d) (\(k, v) -> (c k, d v))++mapCursorNonEmptyCursorL ::+ Lens (MapCursor kc vc k v) (MapCursor lc wc l w) (NonEmptyCursor (KeyValueCursor kc vc k v) ( k+ , v)) (NonEmptyCursor (KeyValueCursor lc wc l w) ( l+ , w))+mapCursorNonEmptyCursorL =+ lens mapCursorList $ \mc ne -> mc {mapCursorList = ne}++mapCursorElemL :: Lens' (MapCursor kc vc k v) (KeyValueCursor kc vc k v)+mapCursorElemL = mapCursorNonEmptyCursorL . nonEmptyCursorElemL++mapCursorSelectKey ::+ (k -> kc) -> (vc -> v) -> MapCursor kc vc k v -> MapCursor kc vc k v+mapCursorSelectKey g h = mapCursorElemL %~ keyValueCursorSelectKey g h++mapCursorSelectValue ::+ (kc -> k) -> (v -> vc) -> MapCursor kc vc k v -> MapCursor kc vc k v+mapCursorSelectValue f i = mapCursorElemL %~ keyValueCursorSelectValue f i++mapCursorToggleSelected ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> (v -> vc)+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorToggleSelected f g h i =+ mapCursorElemL %~ keyValueCursorToggleSelected f g h i++mapCursorSelectPrev ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> MapCursor kc vc k v+ -> Maybe (MapCursor kc vc k v)+mapCursorSelectPrev f g h =+ mapCursorNonEmptyCursorL $ nonEmptyCursorSelectPrev (rebuild f h) (make g)++mapCursorSelectNext ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> MapCursor kc vc k v+ -> Maybe (MapCursor kc vc k v)+mapCursorSelectNext f g h =+ mapCursorNonEmptyCursorL $ nonEmptyCursorSelectNext (rebuild f h) (make g)++mapCursorSelectFirst ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorSelectFirst f g h =+ mapCursorNonEmptyCursorL %~+ (nonEmptyCursorSelectFirst (rebuild f h) (make g))++mapCursorSelectLast ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorSelectLast f g h =+ mapCursorNonEmptyCursorL %~+ (nonEmptyCursorSelectLast (rebuild f h) (make g))++mapCursorSelection :: MapCursor kc vc k v -> Int+mapCursorSelection = nonEmptyCursorSelection . mapCursorList++mapCursorSelectIndex ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> Int+ -> MapCursor kc vc k v+ -> Maybe (MapCursor kc vc k v)+mapCursorSelectIndex f g h i =+ mapCursorNonEmptyCursorL+ (nonEmptyCursorSelectIndex (rebuild f h) (make g) i)++mapCursorInsert :: k -> v -> MapCursor kc vc k v -> MapCursor kc vc k v+mapCursorInsert k v = mapCursorNonEmptyCursorL %~ (nonEmptyCursorInsert (k, v))++mapCursorAppend :: k -> v -> MapCursor kc vc k v -> MapCursor kc vc k v+mapCursorAppend k v = mapCursorNonEmptyCursorL %~ (nonEmptyCursorAppend (k, v))++mapCursorInsertAndSelectKey ::+ (kc -> k)+ -> (vc -> v)+ -> kc+ -> v+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorInsertAndSelectKey f h kc v =+ mapCursorNonEmptyCursorL %~+ (nonEmptyCursorInsertAndSelect (rebuild f h) (makeKeyValueCursorKey kc v))++mapCursorAppendAndSelectKey ::+ (kc -> k)+ -> (vc -> v)+ -> kc+ -> v+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorAppendAndSelectKey f h kc v =+ mapCursorNonEmptyCursorL %~+ (nonEmptyCursorAppendAndSelect (rebuild f h) (makeKeyValueCursorKey kc v))++mapCursorInsertAndSelectValue ::+ (kc -> k)+ -> (vc -> v)+ -> k+ -> vc+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorInsertAndSelectValue f h k vc =+ mapCursorNonEmptyCursorL %~+ (nonEmptyCursorInsertAndSelect (rebuild f h) (makeKeyValueCursorValue k vc))++mapCursorAppendAndSelectValue ::+ (kc -> k)+ -> (vc -> v)+ -> k+ -> vc+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorAppendAndSelectValue f h k vc =+ mapCursorNonEmptyCursorL %~+ (nonEmptyCursorAppendAndSelect (rebuild f h) (makeKeyValueCursorValue k vc))++mapCursorRemoveElemAndSelectPrev ::+ (k -> kc)+ -> MapCursor kc vc k v+ -> Maybe (DeleteOrUpdate (MapCursor kc vc k v))+mapCursorRemoveElemAndSelectPrev g =+ focusPossibleDeleteOrUpdate mapCursorNonEmptyCursorL $+ nonEmptyCursorRemoveElemAndSelectPrev (make g)++mapCursorDeleteElemAndSelectNext ::+ (k -> kc)+ -> MapCursor kc vc k v+ -> Maybe (DeleteOrUpdate (MapCursor kc vc k v))+mapCursorDeleteElemAndSelectNext g =+ focusPossibleDeleteOrUpdate mapCursorNonEmptyCursorL $+ nonEmptyCursorDeleteElemAndSelectNext (make g)++mapCursorRemoveElem ::+ (k -> kc) -> MapCursor kc vc k v -> DeleteOrUpdate (MapCursor kc vc k v)+mapCursorRemoveElem g =+ mapCursorNonEmptyCursorL $ nonEmptyCursorRemoveElem (make g)++mapCursorDeleteElem ::+ (k -> kc) -> MapCursor kc vc k v -> DeleteOrUpdate (MapCursor kc vc k v)+mapCursorDeleteElem g =+ mapCursorNonEmptyCursorL $ nonEmptyCursorDeleteElem (make g)++mapCursorSearch ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> (k -> v -> Bool)+ -> MapCursor kc vc k v+ -> Maybe (MapCursor kc vc k v)+mapCursorSearch f g h p =+ mapCursorNonEmptyCursorL $+ nonEmptyCursorSearch (rebuild f h) (make g) (uncurry p . rebuild f h)++mapCursorSelectOrAdd ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> (k -> v -> Bool)+ -> KeyValueCursor kc vc k v+ -> MapCursor kc vc k v+ -> MapCursor kc vc k v+mapCursorSelectOrAdd f g h p kvc =+ mapCursorNonEmptyCursorL %~+ nonEmptyCursorSelectOrAdd+ (rebuild f h)+ (make g)+ (uncurry p . rebuild f h)+ kvc++rebuild :: (kc -> k) -> (vc -> v) -> KeyValueCursor kc vc k v -> (k, v)+rebuild f h = rebuildKeyValueCursor f h++make :: (k -> kc) -> (k, v) -> KeyValueCursor kc vc k v+make g (k, v) = makeKeyValueCursorKey (g k) v
+ src/Cursor/Map/KeyValue.hs view
@@ -0,0 +1,98 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.Map.KeyValue+ ( KeyValueCursor(..)+ , makeKeyValueCursorKey+ , makeKeyValueCursorValue+ , rebuildKeyValueCursor+ , keyValueCursorSelection+ , mapKeyValueCursor+ , keyValueCursorSelectKey+ , keyValueCursorSelectValue+ , keyValueCursorToggleSelected+ , KeyValueToggle(..)+ ) where++import GHC.Generics (Generic)++import Data.Validity++data KeyValueCursor kc vc k v+ = KeyValueCursorKey kc+ v+ | KeyValueCursorValue k+ vc+ deriving (Show, Eq, Generic)++instance (Validity kc, Validity vc, Validity k, Validity v) =>+ Validity (KeyValueCursor kc vc k v)++makeKeyValueCursorKey :: kc -> v -> KeyValueCursor kc vc k v+makeKeyValueCursorKey = KeyValueCursorKey++makeKeyValueCursorValue :: k -> vc -> KeyValueCursor kc vc k v+makeKeyValueCursorValue = KeyValueCursorValue++rebuildKeyValueCursor ::+ (kc -> k) -> (vc -> v) -> KeyValueCursor kc vc k v -> (k, v)+rebuildKeyValueCursor f _ (KeyValueCursorKey kc v) = (f kc, v)+rebuildKeyValueCursor _ g (KeyValueCursorValue k vc) = (k, g vc)++keyValueCursorSelection :: KeyValueCursor kc vc k v -> KeyValueToggle+keyValueCursorSelection (KeyValueCursorKey _ _) = KeySelected+keyValueCursorSelection (KeyValueCursorValue _ _) = ValueSelected++mapKeyValueCursor ::+ (kc -> lc)+ -> (vc -> wc)+ -> (k -> l)+ -> (v -> w)+ -> KeyValueCursor kc vc k v+ -> KeyValueCursor lc wc l w+mapKeyValueCursor a b c d kvc =+ case kvc of+ KeyValueCursorKey kc v -> KeyValueCursorKey (a kc) (d v)+ KeyValueCursorValue k vc -> KeyValueCursorValue (c k) (b vc)++keyValueCursorSelectKey ::+ (k -> kc)+ -> (vc -> v)+ -> KeyValueCursor kc vc k v+ -> KeyValueCursor kc vc k v+keyValueCursorSelectKey g h kvc =+ case kvc of+ KeyValueCursorValue k vc -> KeyValueCursorKey (g k) (h vc)+ _ -> kvc++keyValueCursorSelectValue ::+ (kc -> k)+ -> (v -> vc)+ -> KeyValueCursor kc vc k v+ -> KeyValueCursor kc vc k v+keyValueCursorSelectValue f i kvc =+ case kvc of+ KeyValueCursorKey kc v -> KeyValueCursorValue (f kc) (i v)+ _ -> kvc++keyValueCursorToggleSelected ::+ (kc -> k)+ -> (k -> kc)+ -> (vc -> v)+ -> (v -> vc)+ -> KeyValueCursor kc vc k v+ -> KeyValueCursor kc vc k v+keyValueCursorToggleSelected f g h i kvc =+ case kvc of+ KeyValueCursorKey kc v -> KeyValueCursorValue (f kc) (i v)+ KeyValueCursorValue k vc -> KeyValueCursorKey (g k) (h vc)++data KeyValueToggle+ = KeySelected+ | ValueSelected+ deriving (Show, Eq, Generic)++instance Validity KeyValueToggle
+ src/Cursor/Simple/Forest.hs view
@@ -0,0 +1,204 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Simple.Forest+ ( ForestCursor+ , makeForestCursor+ , rebuildForestCursor+ , FC.drawForestCursor+ , mapForestCursor+ , FC.forestCursorListCursorL+ , FC.forestCursorSelectedTreeL+ , forestCursorSelectPrevTreeCursor+ , forestCursorSelectNextTreeCursor+ , forestCursorSelectFirstTreeCursor+ , forestCursorSelectLastTreeCursor+ , forestCursorSelectPrev+ , forestCursorSelectNext+ , forestCursorSelectPrevOnSameLevel+ , forestCursorSelectNextOnSameLevel+ , forestCursorSelectFirst+ , forestCursorSelectLast+ , forestCursorSelectBelowAtPos+ , forestCursorSelectBelowAtStart+ , forestCursorSelectBelowAtEnd+ , FC.forestCursorCloseCurrentForest+ , FC.forestCursorOpenCurrentForest+ , FC.forestCursorToggleCurrentForest+ , FC.forestCursorSelection+ , forestCursorSelectIndex+ , FC.forestCursorInsertEntireTree+ , forestCursorInsertAndSelectTreeCursor+ , FC.forestCursorAppendEntireTree+ , forestCursorAppendAndSelectTreeCursor+ , FC.forestCursorInsertTree+ , FC.forestCursorAppendTree+ , forestCursorInsertAndSelectTree+ , forestCursorAppendAndSelectTree+ , FC.forestCursorInsert+ , FC.forestCursorAppend+ , forestCursorInsertAndSelect+ , forestCursorAppendAndSelect+ , FC.forestCursorAddChildTreeToNodeAtPos+ , FC.forestCursorAddChildTreeToNodeAtStart+ , FC.forestCursorAddChildTreeToNodeAtEnd+ , FC.forestCursorAddChildToNodeAtPos+ , FC.forestCursorAddChildToNodeAtStart+ , FC.forestCursorAddChildToNodeAtEnd+ , forestCursorRemoveElemAndSelectPrev+ , forestCursorDeleteElemAndSelectNext+ , forestCursorRemoveElem+ , forestCursorDeleteElem+ , forestCursorRemoveSubTreeAndSelectPrev+ , forestCursorDeleteSubTreeAndSelectNext+ , forestCursorRemoveSubTree+ , forestCursorDeleteSubTree+ , forestCursorAddRoot+ , FC.forestCursorSwapPrev+ , FC.forestCursorSwapNext+ , forestCursorPromoteElem+ , forestCursorPromoteSubTree+ , forestCursorDemoteElem+ , forestCursorDemoteSubTree+ , FC.forestCursorDemoteElemUnder+ , FC.forestCursorDemoteSubTreeUnder+ , FC.CTree(..)+ , FC.makeCTree+ , FC.cTree+ , FC.rebuildCTree+ , FC.CForest(..)+ , FC.makeCForest+ , FC.cForest+ , FC.rebuildCForest+ ) where++import Data.Validity.Tree ()++import Data.List.NonEmpty (NonEmpty)+import Data.Tree++import qualified Cursor.Forest as FC+import Cursor.Simple.Tree+import Cursor.Types++type ForestCursor a = FC.ForestCursor a a++makeForestCursor :: NonEmpty (CTree a) -> ForestCursor a+makeForestCursor = FC.makeForestCursor id++rebuildForestCursor :: ForestCursor a -> NonEmpty (CTree a)+rebuildForestCursor = FC.rebuildForestCursor id++mapForestCursor :: (a -> b) -> ForestCursor a -> ForestCursor b+mapForestCursor f = FC.mapForestCursor f f++forestCursorSelectPrevTreeCursor :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectPrevTreeCursor = FC.forestCursorSelectPrevTreeCursor id id++forestCursorSelectNextTreeCursor :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectNextTreeCursor = FC.forestCursorSelectNextTreeCursor id id++forestCursorSelectFirstTreeCursor :: ForestCursor a -> ForestCursor a+forestCursorSelectFirstTreeCursor = FC.forestCursorSelectFirstTreeCursor id id++forestCursorSelectLastTreeCursor :: ForestCursor a -> ForestCursor a+forestCursorSelectLastTreeCursor = FC.forestCursorSelectLastTreeCursor id id++forestCursorSelectNext :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectNext = FC.forestCursorSelectNext id id++forestCursorSelectPrev :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectPrev = FC.forestCursorSelectPrev id id++forestCursorSelectNextOnSameLevel :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectNextOnSameLevel = FC.forestCursorSelectNextOnSameLevel id id++forestCursorSelectPrevOnSameLevel :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectPrevOnSameLevel = FC.forestCursorSelectPrevOnSameLevel id id++forestCursorSelectFirst :: ForestCursor a -> ForestCursor a+forestCursorSelectFirst = FC.forestCursorSelectFirst id id++forestCursorSelectLast :: ForestCursor a -> ForestCursor a+forestCursorSelectLast = FC.forestCursorSelectLast id id++forestCursorSelectBelowAtPos :: Int -> ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectBelowAtPos = FC.forestCursorSelectBelowAtPos id id++forestCursorSelectBelowAtStart :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectBelowAtStart = FC.forestCursorSelectBelowAtStart id id++forestCursorSelectBelowAtEnd :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectBelowAtEnd = FC.forestCursorSelectBelowAtEnd id id++forestCursorSelectIndex :: Int -> ForestCursor a -> Maybe (ForestCursor a)+forestCursorSelectIndex = FC.forestCursorSelectIndex id id++forestCursorInsertAndSelectTreeCursor ::+ TreeCursor a -> ForestCursor a -> ForestCursor a+forestCursorInsertAndSelectTreeCursor =+ FC.forestCursorInsertAndSelectTreeCursor id++forestCursorAppendAndSelectTreeCursor ::+ TreeCursor a -> ForestCursor a -> ForestCursor a+forestCursorAppendAndSelectTreeCursor =+ FC.forestCursorAppendAndSelectTreeCursor id++forestCursorInsertAndSelectTree :: Tree a -> ForestCursor a -> ForestCursor a+forestCursorInsertAndSelectTree = FC.forestCursorInsertAndSelectTree id id++forestCursorAppendAndSelectTree :: Tree a -> ForestCursor a -> ForestCursor a+forestCursorAppendAndSelectTree = FC.forestCursorAppendAndSelectTree id id++forestCursorInsertAndSelect :: a -> ForestCursor a -> ForestCursor a+forestCursorInsertAndSelect = FC.forestCursorInsertAndSelect id id++forestCursorAppendAndSelect :: a -> ForestCursor a -> ForestCursor a+forestCursorAppendAndSelect = FC.forestCursorAppendAndSelect id id++forestCursorRemoveElemAndSelectPrev ::+ ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a))+forestCursorRemoveElemAndSelectPrev = FC.forestCursorRemoveElemAndSelectPrev id++forestCursorDeleteElemAndSelectNext ::+ ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a))+forestCursorDeleteElemAndSelectNext = FC.forestCursorDeleteElemAndSelectNext id++forestCursorRemoveElem :: ForestCursor a -> DeleteOrUpdate (ForestCursor a)+forestCursorRemoveElem = FC.forestCursorRemoveElem id++forestCursorDeleteElem :: ForestCursor a -> DeleteOrUpdate (ForestCursor a)+forestCursorDeleteElem = FC.forestCursorDeleteElem id++forestCursorRemoveSubTreeAndSelectPrev ::+ ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a))+forestCursorRemoveSubTreeAndSelectPrev =+ FC.forestCursorRemoveSubTreeAndSelectPrev id++forestCursorDeleteSubTreeAndSelectNext ::+ ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a))+forestCursorDeleteSubTreeAndSelectNext =+ FC.forestCursorDeleteSubTreeAndSelectNext id++forestCursorRemoveSubTree :: ForestCursor a -> DeleteOrUpdate (ForestCursor a)+forestCursorRemoveSubTree = FC.forestCursorRemoveSubTree id++forestCursorDeleteSubTree :: ForestCursor a -> DeleteOrUpdate (ForestCursor a)+forestCursorDeleteSubTree = FC.forestCursorDeleteSubTree id++forestCursorAddRoot :: ForestCursor a -> a -> TreeCursor a+forestCursorAddRoot = FC.forestCursorAddRoot id id++forestCursorPromoteElem :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorPromoteElem = FC.forestCursorPromoteElem id id++forestCursorPromoteSubTree :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorPromoteSubTree = FC.forestCursorPromoteSubTree id id++forestCursorDemoteElem :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorDemoteElem = FC.forestCursorDemoteElem id id++forestCursorDemoteSubTree :: ForestCursor a -> Maybe (ForestCursor a)+forestCursorDemoteSubTree = FC.forestCursorDemoteSubTree id id
+ src/Cursor/Simple/List/NonEmpty.hs view
@@ -0,0 +1,114 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Simple.List.NonEmpty+ ( NonEmptyCursor+ , NEC.nonEmptyCursorPrev+ , NEC.nonEmptyCursorCurrent+ , NEC.nonEmptyCursorNext+ , makeNonEmptyCursor+ , makeNonEmptyCursorWithSelection+ , NEC.singletonNonEmptyCursor+ , rebuildNonEmptyCursor+ , mapNonEmptyCursor+ , NEC.nonEmptyCursorElemL+ , nonEmptyCursorSelectPrev+ , nonEmptyCursorSelectNext+ , nonEmptyCursorSelectFirst+ , nonEmptyCursorSelectLast+ , NEC.nonEmptyCursorSelection+ , nonEmptyCursorSelectIndex+ , NEC.nonEmptyCursorInsert+ , NEC.nonEmptyCursorAppend+ , nonEmptyCursorInsertAndSelect+ , nonEmptyCursorAppendAndSelect+ , NEC.nonEmptyCursorInsertAtStart+ , NEC.nonEmptyCursorAppendAtEnd+ , nonEmptyCursorInsertAtStartAndSelect+ , nonEmptyCursorAppendAtEndAndSelect+ , nonEmptyCursorRemoveElemAndSelectPrev+ , nonEmptyCursorDeleteElemAndSelectNext+ , nonEmptyCursorRemoveElem+ , nonEmptyCursorDeleteElem+ , nonEmptyCursorSearch+ , nonEmptyCursorSelectOrAdd+ ) where++import Data.List.NonEmpty (NonEmpty(..))++import Cursor.Types++import qualified Cursor.List.NonEmpty as NEC++-- | A 'nonempty list' cursor+type NonEmptyCursor a = NEC.NonEmptyCursor a a++makeNonEmptyCursor :: NonEmpty a -> NonEmptyCursor a+makeNonEmptyCursor = NEC.makeNonEmptyCursor id++makeNonEmptyCursorWithSelection :: Int -> NonEmpty a -> Maybe (NonEmptyCursor a)+makeNonEmptyCursorWithSelection = NEC.makeNonEmptyCursorWithSelection id++rebuildNonEmptyCursor :: NonEmptyCursor a -> NonEmpty a+rebuildNonEmptyCursor = NEC.rebuildNonEmptyCursor id++mapNonEmptyCursor :: (a -> b) -> NonEmptyCursor a -> NonEmptyCursor b+mapNonEmptyCursor f = NEC.mapNonEmptyCursor f f++nonEmptyCursorSelectPrev :: NonEmptyCursor a -> Maybe (NonEmptyCursor a)+nonEmptyCursorSelectPrev = NEC.nonEmptyCursorSelectPrev id id++nonEmptyCursorSelectNext :: NonEmptyCursor a -> Maybe (NonEmptyCursor a)+nonEmptyCursorSelectNext = NEC.nonEmptyCursorSelectNext id id++nonEmptyCursorSelectFirst :: NonEmptyCursor a -> NonEmptyCursor a+nonEmptyCursorSelectFirst = NEC.nonEmptyCursorSelectFirst id id++nonEmptyCursorSelectLast :: NonEmptyCursor a -> NonEmptyCursor a+nonEmptyCursorSelectLast = NEC.nonEmptyCursorSelectLast id id++nonEmptyCursorSelectIndex :: Int -> NonEmptyCursor a -> Maybe (NonEmptyCursor a)+nonEmptyCursorSelectIndex = NEC.nonEmptyCursorSelectIndex id id++nonEmptyCursorInsertAndSelect :: a -> NonEmptyCursor a -> NonEmptyCursor a+nonEmptyCursorInsertAndSelect = NEC.nonEmptyCursorInsertAndSelect id++nonEmptyCursorAppendAndSelect :: a -> NonEmptyCursor a -> NonEmptyCursor a+nonEmptyCursorAppendAndSelect = NEC.nonEmptyCursorAppendAndSelect id++nonEmptyCursorInsertAtStartAndSelect ::+ a -> NonEmptyCursor a -> NonEmptyCursor a+nonEmptyCursorInsertAtStartAndSelect =+ NEC.nonEmptyCursorInsertAtStartAndSelect id id++nonEmptyCursorAppendAtEndAndSelect :: a -> NonEmptyCursor a -> NonEmptyCursor a+nonEmptyCursorAppendAtEndAndSelect =+ NEC.nonEmptyCursorAppendAtEndAndSelect id id++nonEmptyCursorRemoveElemAndSelectPrev ::+ NonEmptyCursor a -> Maybe (DeleteOrUpdate (NonEmptyCursor a))+nonEmptyCursorRemoveElemAndSelectPrev =+ NEC.nonEmptyCursorRemoveElemAndSelectPrev id++nonEmptyCursorDeleteElemAndSelectNext ::+ NonEmptyCursor a -> Maybe (DeleteOrUpdate (NonEmptyCursor a))+nonEmptyCursorDeleteElemAndSelectNext =+ NEC.nonEmptyCursorDeleteElemAndSelectNext id++nonEmptyCursorRemoveElem ::+ NonEmptyCursor a -> DeleteOrUpdate (NonEmptyCursor a)+nonEmptyCursorRemoveElem = NEC.nonEmptyCursorRemoveElem id++nonEmptyCursorDeleteElem ::+ NonEmptyCursor a -> DeleteOrUpdate (NonEmptyCursor a)+nonEmptyCursorDeleteElem = NEC.nonEmptyCursorDeleteElem id++nonEmptyCursorSearch ::+ (a -> Bool) -> NonEmptyCursor a -> Maybe (NonEmptyCursor a)+nonEmptyCursorSearch = NEC.nonEmptyCursorSearch id id++nonEmptyCursorSelectOrAdd ::+ (a -> Bool) -> a -> NonEmptyCursor a -> NonEmptyCursor a+nonEmptyCursorSelectOrAdd = NEC.nonEmptyCursorSelectOrAdd id id
+ src/Cursor/Simple/Map.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.Simple.Map+ ( MapCursor+ , MC.mapCursorList+ , makeMapCursor+ , makeMapCursorWithSelection+ , MC.singletonMapCursorKey+ , MC.singletonMapCursorValue+ , rebuildMapCursor+ , mapMapCursor+ , MC.mapCursorNonEmptyCursorL+ , MC.mapCursorElemL+ , mapCursorSelectKey+ , mapCursorSelectValue+ , mapCursorToggleSelected+ , mapCursorSelectPrev+ , mapCursorSelectNext+ , mapCursorSelectFirst+ , mapCursorSelectLast+ , MC.mapCursorSelection+ , mapCursorSelectIndex+ , MC.mapCursorInsert+ , MC.mapCursorAppend+ , mapCursorInsertAndSelectKey+ , mapCursorAppendAndSelectKey+ , mapCursorInsertAndSelectValue+ , mapCursorAppendAndSelectValue+ , mapCursorRemoveElemAndSelectPrev+ , mapCursorDeleteElemAndSelectNext+ , mapCursorRemoveElem+ , mapCursorDeleteElem+ , mapCursorSearch+ , mapCursorSelectOrAdd+ , module Cursor.Simple.Map.KeyValue+ ) where++import Data.List.NonEmpty (NonEmpty(..))++import qualified Cursor.Map as MC+import Cursor.Simple.Map.KeyValue+import Cursor.Types++type MapCursor k v = MC.MapCursor k v k v++makeMapCursor :: NonEmpty (k, v) -> MapCursor k v+makeMapCursor = MC.makeMapCursor id++makeMapCursorWithSelection :: Int -> NonEmpty (k, v) -> Maybe (MapCursor k v)+makeMapCursorWithSelection = MC.makeMapCursorWithSelection id++rebuildMapCursor :: MapCursor k v -> NonEmpty (k, v)+rebuildMapCursor = MC.rebuildMapCursor id id++mapMapCursor :: (k -> l) -> (v -> w) -> MapCursor k v -> MapCursor l w+mapMapCursor f g = MC.mapMapCursor f g f g++mapCursorSelectKey :: MapCursor k v -> MapCursor k v+mapCursorSelectKey = MC.mapCursorSelectKey id id++mapCursorSelectValue :: MapCursor k v -> MapCursor k v+mapCursorSelectValue = MC.mapCursorSelectValue id id++mapCursorToggleSelected :: MapCursor k v -> MapCursor k v+mapCursorToggleSelected = MC.mapCursorToggleSelected id id id id++mapCursorSelectPrev :: MapCursor k v -> Maybe (MapCursor k v)+mapCursorSelectPrev = MC.mapCursorSelectPrev id id id++mapCursorSelectNext :: MapCursor k v -> Maybe (MapCursor k v)+mapCursorSelectNext = MC.mapCursorSelectNext id id id++mapCursorSelectFirst :: MapCursor k v -> MapCursor k v+mapCursorSelectFirst = MC.mapCursorSelectFirst id id id++mapCursorSelectLast :: MapCursor k v -> MapCursor k v+mapCursorSelectLast = MC.mapCursorSelectLast id id id++mapCursorSelectIndex :: Int -> MapCursor k v -> Maybe (MapCursor k v)+mapCursorSelectIndex = MC.mapCursorSelectIndex id id id++mapCursorInsertAndSelectKey :: k -> v -> MapCursor k v -> MapCursor k v+mapCursorInsertAndSelectKey = MC.mapCursorInsertAndSelectKey id id++mapCursorAppendAndSelectKey :: k -> v -> MapCursor k v -> MapCursor k v+mapCursorAppendAndSelectKey = MC.mapCursorAppendAndSelectKey id id++mapCursorInsertAndSelectValue :: k -> v -> MapCursor k v -> MapCursor k v+mapCursorInsertAndSelectValue = MC.mapCursorInsertAndSelectValue id id++mapCursorAppendAndSelectValue :: k -> v -> MapCursor k v -> MapCursor k v+mapCursorAppendAndSelectValue = MC.mapCursorAppendAndSelectValue id id++mapCursorRemoveElemAndSelectPrev ::+ MapCursor k v -> Maybe (DeleteOrUpdate (MapCursor k v))+mapCursorRemoveElemAndSelectPrev = MC.mapCursorRemoveElemAndSelectPrev id++mapCursorDeleteElemAndSelectNext ::+ MapCursor k v -> Maybe (DeleteOrUpdate (MapCursor k v))+mapCursorDeleteElemAndSelectNext = MC.mapCursorDeleteElemAndSelectNext id++mapCursorRemoveElem :: MapCursor k v -> DeleteOrUpdate (MapCursor k v)+mapCursorRemoveElem = MC.mapCursorRemoveElem id++mapCursorDeleteElem :: MapCursor k v -> DeleteOrUpdate (MapCursor k v)+mapCursorDeleteElem = MC.mapCursorDeleteElem id++mapCursorSearch :: (k -> v -> Bool) -> MapCursor k v -> Maybe (MapCursor k v)+mapCursorSearch = MC.mapCursorSearch id id id++mapCursorSelectOrAdd ::+ (k -> v -> Bool) -> KeyValueCursor k v -> MapCursor k v -> MapCursor k v+mapCursorSelectOrAdd = MC.mapCursorSelectOrAdd id id id
+ src/Cursor/Simple/Map/KeyValue.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE PatternSynonyms #-}++module Cursor.Simple.Map.KeyValue+ ( KeyValueCursor+ , pattern KVC.KeyValueCursorKey+ , pattern KVC.KeyValueCursorValue+ , KVC.makeKeyValueCursorKey+ , KVC.makeKeyValueCursorValue+ , rebuildKeyValueCursor+ , KVC.keyValueCursorSelection+ , mapKeyValueCursor+ , keyValueCursorSelectKey+ , keyValueCursorSelectValue+ , keyValueCursorToggleSelected+ , KVC.KeyValueToggle(..)+ ) where++import qualified Cursor.Map.KeyValue as KVC++type KeyValueCursor k v = KVC.KeyValueCursor k v k v++rebuildKeyValueCursor :: KeyValueCursor k v -> (k, v)+rebuildKeyValueCursor = KVC.rebuildKeyValueCursor id id++mapKeyValueCursor ::+ (k -> l) -> (v -> w) -> KeyValueCursor k v -> KeyValueCursor l w+mapKeyValueCursor f g = KVC.mapKeyValueCursor f g f g++keyValueCursorSelectKey :: KeyValueCursor k v -> KeyValueCursor k v+keyValueCursorSelectKey = KVC.keyValueCursorSelectKey id id++keyValueCursorSelectValue :: KeyValueCursor k v -> KeyValueCursor k v+keyValueCursorSelectValue = KVC.keyValueCursorSelectValue id id++keyValueCursorToggleSelected :: KeyValueCursor k v -> KeyValueCursor k v+keyValueCursorToggleSelected = KVC.keyValueCursorToggleSelected id id id id
+ src/Cursor/Simple/Tree.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Simple.Tree+ ( TreeCursor+ , TreeAbove(..)+ , singletonTreeCursor+ , makeTreeCursor+ , makeTreeCursorWithSelection+ , rebuildTreeCursor+ , TC.drawTreeCursor+ , mapTreeCursor+ , TC.treeCursorAboveL+ , TC.treeCursorCurrentL+ , TC.treeCursorBelowL+ , TC.treeAboveLeftsL+ , TC.treeAboveAboveL+ , TC.treeAboveNodeL+ , TC.treeAboveRightsL+ , TC.treeCursorWithPointer+ , TC.treeCursorSelection+ , TC.TreeCursorSelection(..)+ , treeCursorSelect+ , treeCursorSelectPrev+ , treeCursorSelectNext+ , treeCursorSelectFirst+ , treeCursorSelectLast+ , treeCursorSelectAbove+ , treeCursorSelectBelowAtPos+ , treeCursorSelectBelowAtStart+ , treeCursorSelectBelowAtEnd+ , treeCursorSelectBelowAtStartRecursively+ , treeCursorSelectBelowAtEndRecursively+ , treeCursorSelectPrevOnSameLevel+ , treeCursorSelectNextOnSameLevel+ , treeCursorSelectAbovePrev+ , treeCursorSelectAboveNext+ , TC.treeCursorCloseCurrentForest+ , TC.treeCursorOpenCurrentForest+ , TC.treeCursorToggleCurrentForest+ , TC.treeCursorInsert+ , treeCursorInsertAndSelect+ , TC.treeCursorAppend+ , treeCursorAppendAndSelect+ , TC.treeCursorAddChildAtPos+ , TC.treeCursorAddChildAtStart+ , TC.treeCursorAddChildAtEnd+ , treeCursorDeleteSubTreeAndSelectPrevious+ , treeCursorDeleteSubTreeAndSelectNext+ , treeCursorDeleteSubTreeAndSelectAbove+ , treeCursorRemoveSubTree+ , treeCursorDeleteSubTree+ , treeCursorDeleteElemAndSelectPrevious+ , treeCursorDeleteElemAndSelectNext+ , treeCursorDeleteElemAndSelectAbove+ , treeCursorRemoveElem+ , treeCursorDeleteElem+ , TC.treeCursorSwapPrev+ , TC.treeCursorSwapNext+ , TC.SwapResult(..)+ , treeCursorPromoteElem+ , TC.PromoteElemResult(..)+ , treeCursorPromoteSubTree+ , TC.PromoteResult(..)+ , treeCursorDemoteElem+ , treeCursorDemoteSubTree+ , TC.DemoteResult(..)+ , TC.treeCursorDemoteElemUnder+ , TC.treeCursorDemoteSubTreeUnder+ , TC.CTree(..)+ , TC.CForest+ , TC.makeCTree+ , TC.cTree+ , TC.rebuildCTree+ ) where++import Data.Tree++import Cursor.Types++import qualified Cursor.Tree as TC+import Cursor.Tree (CTree, TreeAbove(..))++type TreeCursor a = TC.TreeCursor a a++makeTreeCursor :: CTree a -> TreeCursor a+makeTreeCursor = TC.makeTreeCursor id++makeTreeCursorWithSelection ::+ TC.TreeCursorSelection -> CTree a -> Maybe (TreeCursor a)+makeTreeCursorWithSelection = TC.makeTreeCursorWithSelection id id++singletonTreeCursor :: a -> TreeCursor a+singletonTreeCursor = TC.singletonTreeCursor++rebuildTreeCursor :: TreeCursor a -> CTree a+rebuildTreeCursor = TC.rebuildTreeCursor id++mapTreeCursor :: (a -> b) -> TreeCursor a -> TreeCursor b+mapTreeCursor f = TC.mapTreeCursor f f++treeCursorSelect ::+ TC.TreeCursorSelection -> TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelect = TC.treeCursorSelect id id++treeCursorSelectPrev :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectPrev = TC.treeCursorSelectPrev id id++treeCursorSelectNext :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectNext = TC.treeCursorSelectNext id id++treeCursorSelectFirst :: TreeCursor a -> TreeCursor a+treeCursorSelectFirst = TC.treeCursorSelectFirst id id++treeCursorSelectLast :: TreeCursor a -> TreeCursor a+treeCursorSelectLast = TC.treeCursorSelectLast id id++treeCursorSelectAbove :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectAbove = TC.treeCursorSelectAbove id id++treeCursorSelectBelowAtPos :: Int -> TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectBelowAtPos = TC.treeCursorSelectBelowAtPos id id++treeCursorSelectBelowAtStart :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectBelowAtStart = TC.treeCursorSelectBelowAtStart id id++treeCursorSelectBelowAtEnd :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectBelowAtEnd = TC.treeCursorSelectBelowAtEnd id id++treeCursorSelectBelowAtStartRecursively :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectBelowAtStartRecursively =+ TC.treeCursorSelectBelowAtStartRecursively id id++treeCursorSelectBelowAtEndRecursively :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectBelowAtEndRecursively =+ TC.treeCursorSelectBelowAtEndRecursively id id++treeCursorSelectPrevOnSameLevel :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectPrevOnSameLevel = TC.treeCursorSelectPrevOnSameLevel id id++treeCursorSelectNextOnSameLevel :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectNextOnSameLevel = TC.treeCursorSelectNextOnSameLevel id id++-- | Go back and down as far as necessary to find a previous element on a level below+treeCursorSelectAbovePrev :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectAbovePrev = TC.treeCursorSelectAbovePrev id id++-- | Go up as far as necessary to find a next element on a level above and forward+--+-- Note: This will fail if there is a next node on the same level or any node below the current node+treeCursorSelectAboveNext :: TreeCursor a -> Maybe (TreeCursor a)+treeCursorSelectAboveNext = TC.treeCursorSelectAboveNext id id++treeCursorInsertAndSelect :: Tree a -> TreeCursor a -> Maybe (TreeCursor a)+treeCursorInsertAndSelect = TC.treeCursorInsertAndSelect id id++treeCursorAppendAndSelect :: Tree a -> TreeCursor a -> Maybe (TreeCursor a)+treeCursorAppendAndSelect = TC.treeCursorAppendAndSelect id id++treeCursorDeleteSubTreeAndSelectPrevious ::+ TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a))+treeCursorDeleteSubTreeAndSelectPrevious =+ TC.treeCursorDeleteSubTreeAndSelectPrevious id++treeCursorDeleteSubTreeAndSelectNext ::+ TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a))+treeCursorDeleteSubTreeAndSelectNext =+ TC.treeCursorDeleteSubTreeAndSelectNext id++treeCursorDeleteSubTreeAndSelectAbove ::+ TreeCursor a -> DeleteOrUpdate (TreeCursor a)+treeCursorDeleteSubTreeAndSelectAbove =+ TC.treeCursorDeleteSubTreeAndSelectAbove id++treeCursorRemoveSubTree :: TreeCursor a -> DeleteOrUpdate (TreeCursor a)+treeCursorRemoveSubTree = TC.treeCursorRemoveSubTree id++treeCursorDeleteSubTree :: TreeCursor a -> DeleteOrUpdate (TreeCursor a)+treeCursorDeleteSubTree = TC.treeCursorDeleteSubTree id++treeCursorDeleteElemAndSelectPrevious ::+ TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a))+treeCursorDeleteElemAndSelectPrevious =+ TC.treeCursorDeleteElemAndSelectPrevious id++treeCursorDeleteElemAndSelectNext ::+ TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a))+treeCursorDeleteElemAndSelectNext = TC.treeCursorDeleteElemAndSelectNext id++treeCursorDeleteElemAndSelectAbove ::+ TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a))+treeCursorDeleteElemAndSelectAbove = TC.treeCursorDeleteElemAndSelectAbove id++treeCursorRemoveElem :: TreeCursor a -> DeleteOrUpdate (TreeCursor a)+treeCursorRemoveElem = TC.treeCursorRemoveElem id++treeCursorDeleteElem :: TreeCursor a -> DeleteOrUpdate (TreeCursor a)+treeCursorDeleteElem = TC.treeCursorDeleteElem id++treeCursorPromoteElem :: TreeCursor a -> TC.PromoteElemResult (TreeCursor a)+treeCursorPromoteElem = TC.treeCursorPromoteElem id id++treeCursorPromoteSubTree :: TreeCursor a -> TC.PromoteResult (TreeCursor a)+treeCursorPromoteSubTree = TC.treeCursorPromoteSubTree id id++treeCursorDemoteElem :: TreeCursor a -> TC.DemoteResult (TreeCursor a)+treeCursorDemoteElem = TC.treeCursorDemoteElem id id++treeCursorDemoteSubTree :: TreeCursor a -> TC.DemoteResult (TreeCursor a)+treeCursorDemoteSubTree = TC.treeCursorDemoteSubTree id id
+ src/Cursor/Text.hs view
@@ -0,0 +1,125 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.Text+ ( TextCursor(..)+ , emptyTextCursor+ , makeTextCursor+ , makeTextCursorWithSelection+ , rebuildTextCursor+ , textCursorNull+ , textCursorLength+ , textCursorIndex+ , textCursorSelectPrev+ , textCursorSelectNext+ , textCursorSelectIndex+ , textCursorSelectStart+ , textCursorSelectEnd+ , textCursorPrevChar+ , textCursorNextChar+ , textCursorInsert+ , textCursorAppend+ , textCursorRemove+ , textCursorDelete+ , textCursorSplit+ , textCursorCombine+ ) where++import Data.Validity+import GHC.Generics (Generic)++import qualified Data.Text as T+import Data.Text (Text)++import Lens.Micro++import Cursor.List++-- | A cursor for single-line texts+newtype TextCursor = TextCursor+ { textCursorList :: ListCursor Char+ } deriving (Show, Eq, Generic)++instance Validity TextCursor where+ validate (TextCursor lc) =+ mconcat+ [ genericValidate lc+ , decorateList (rebuildListCursor lc) $ \c ->+ declare "The character is not a newline character" $ c /= '\n'+ ]++emptyTextCursor :: TextCursor+emptyTextCursor = TextCursor emptyListCursor++makeTextCursor :: Text -> Maybe TextCursor+makeTextCursor t = makeTextCursorWithSelection (T.length t) t++makeTextCursorWithSelection :: Int -> Text -> Maybe TextCursor+makeTextCursorWithSelection i t =+ case T.split (== '\n') t of+ [l] -> TextCursor <$> makeListCursorWithSelection i (T.unpack l)+ _ -> Nothing++rebuildTextCursor :: TextCursor -> Text+rebuildTextCursor = T.pack . rebuildListCursor . textCursorList++textCursorListCursorL ::+ Functor f+ => (ListCursor Char -> f (ListCursor Char))+ -> TextCursor+ -> f TextCursor+textCursorListCursorL = lens textCursorList (\tc lc -> tc {textCursorList = lc})++textCursorNull :: TextCursor -> Bool+textCursorNull = listCursorNull . textCursorList++textCursorLength :: TextCursor -> Int+textCursorLength = listCursorLength . textCursorList++textCursorIndex :: TextCursor -> Int+textCursorIndex = listCursorIndex . textCursorList++textCursorSelectPrev :: TextCursor -> Maybe TextCursor+textCursorSelectPrev = textCursorListCursorL listCursorSelectPrev++textCursorSelectNext :: TextCursor -> Maybe TextCursor+textCursorSelectNext = textCursorListCursorL listCursorSelectNext++textCursorSelectIndex :: Int -> TextCursor -> TextCursor+textCursorSelectIndex ix_ = textCursorListCursorL %~ listCursorSelectIndex ix_++textCursorSelectStart :: TextCursor -> TextCursor+textCursorSelectStart = textCursorListCursorL %~ listCursorSelectStart++textCursorSelectEnd :: TextCursor -> TextCursor+textCursorSelectEnd = textCursorListCursorL %~ listCursorSelectEnd++textCursorPrevChar :: TextCursor -> Maybe Char+textCursorPrevChar = listCursorPrevItem . textCursorList++textCursorNextChar :: TextCursor -> Maybe Char+textCursorNextChar = listCursorNextItem . textCursorList++textCursorInsert :: Char -> TextCursor -> Maybe TextCursor+textCursorInsert '\n' _ = Nothing+textCursorInsert c tc = Just (tc & textCursorListCursorL %~ listCursorInsert c)++textCursorAppend :: Char -> TextCursor -> Maybe TextCursor+textCursorAppend '\n' _ = Nothing+textCursorAppend c tc = Just (tc & textCursorListCursorL %~ listCursorAppend c)++textCursorRemove :: TextCursor -> Maybe TextCursor+textCursorRemove = textCursorListCursorL listCursorRemove++textCursorDelete :: TextCursor -> Maybe TextCursor+textCursorDelete = textCursorListCursorL listCursorDelete++textCursorSplit :: TextCursor -> (TextCursor, TextCursor)+textCursorSplit tc =+ let (lc1, lc2) = listCursorSplit $ textCursorList tc+ in (TextCursor lc1, TextCursor lc2)++textCursorCombine :: TextCursor -> TextCursor -> TextCursor+textCursorCombine (TextCursor lc1) (TextCursor lc2) =+ TextCursor {textCursorList = listCursorCombine lc1 lc2}
+ src/Cursor/TextField.hs view
@@ -0,0 +1,286 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}++module Cursor.TextField+ ( TextFieldCursor(..)+ , makeTextFieldCursor+ , makeTextFieldCursorWithSelection+ , rebuildTextFieldCursorLines+ , rebuildTextFieldCursor+ , emptyTextFieldCursor+ , nullTextFieldCursor+ , textFieldCursorSelection+ , textFieldCursorNonEmptyCursorL+ , textFieldCursorSelectedL+ , textFieldCursorSelectPrevLine+ , textFieldCursorSelectNextLine+ , textFieldCursorSelectFirstLine+ , textFieldCursorSelectLastLine+ , textFieldCursorSelectPrevChar+ , textFieldCursorSelectNextChar+ , textFieldCursorIndexOnLine+ , textFieldCursorSelectIndexOnLine+ , textFieldCursorInsertChar+ , textFieldCursorAppendChar+ , textFieldCursorInsertNewline+ , textFieldCursorAppendNewline+ , textFieldCursorRemove+ , textFieldCursorDelete+ , textFieldCursorSelectStartOfLine+ , textFieldCursorSelectEndOfLine+ ) where++import GHC.Generics (Generic)++import Data.Validity+import Data.Validity.Text ()++import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Maybe+import qualified Data.Text as T+import Data.Text (Text)++import Control.Monad++import Lens.Micro++import Cursor.List.NonEmpty+import Cursor.Text+import Cursor.Types++newtype TextFieldCursor = TextFieldCursor+ { textFieldCursorNonEmpty :: NonEmptyCursor TextCursor Text+ } deriving (Show, Eq, Generic)++instance Validity TextFieldCursor where+ validate tfc@TextFieldCursor {..} =+ mconcat+ [ genericValidate tfc+ , decorate "None of the texts contain newlines" $+ mconcat $+ NE.toList $+ flip+ NE.map+ (NE.zip (fromJust $ NE.nonEmpty [0 ..]) $+ rebuildNonEmptyCursor+ rebuildTextCursor+ textFieldCursorNonEmpty) $ \(i, tc) ->+ declare+ (unwords+ [ "The text of the line at index"+ , show (i :: Int)+ , "does not contain any newlines"+ ]) $+ T.all (/= '\n') tc+ ]++makeTextFieldCursor :: Text -> TextFieldCursor+makeTextFieldCursor = fromJust . makeTextFieldCursorWithSelection 0 0++makeTextFieldCursorWithSelection :: Int -> Int -> Text -> Maybe TextFieldCursor+makeTextFieldCursorWithSelection x y t = do+ let ls+ -- This is safe because 'splitOn' always returns a nonempty list.+ = NE.fromList $ T.split (== '\n') t+ guard (x >= 0)+ guard (x < NE.length ls)+ nec <-+ makeNonEmptyCursorWithSelection+ -- This is safe because we already checked that it would work above+ (makeTextCursorWithSelection y)+ x+ ls+ void $ nonEmptyCursorCurrent nec+ pure $ TextFieldCursor (nec & nonEmptyCursorElemL %~ fromJust)++rebuildTextFieldCursorLines :: TextFieldCursor -> NonEmpty Text+rebuildTextFieldCursorLines =+ rebuildNonEmptyCursor rebuildTextCursor . textFieldCursorNonEmpty++rebuildTextFieldCursor :: TextFieldCursor -> Text+rebuildTextFieldCursor =+ T.intercalate "\n" . NE.toList . rebuildTextFieldCursorLines++emptyTextFieldCursor :: TextFieldCursor+emptyTextFieldCursor =+ TextFieldCursor+ {textFieldCursorNonEmpty = singletonNonEmptyCursor emptyTextCursor}++nullTextFieldCursor :: TextFieldCursor -> Bool+nullTextFieldCursor = (== emptyTextFieldCursor)++textFieldCursorSelection :: TextFieldCursor -> (Int, Int)+textFieldCursorSelection tfc =+ ( nonEmptyCursorSelection $ textFieldCursorNonEmpty tfc+ , textCursorIndex $ textFieldCursorNonEmpty tfc ^. nonEmptyCursorElemL)++textFieldCursorNonEmptyCursorL ::+ Lens' TextFieldCursor (NonEmptyCursor TextCursor Text)+textFieldCursorNonEmptyCursorL =+ lens textFieldCursorNonEmpty $ \tfc lec ->+ tfc {textFieldCursorNonEmpty = lec}++textFieldCursorSelectedL :: Lens' TextFieldCursor TextCursor+textFieldCursorSelectedL = textFieldCursorNonEmptyCursorL . nonEmptyCursorElemL++textFieldCursorSelectPrevLine :: TextFieldCursor -> Maybe TextFieldCursor+textFieldCursorSelectPrevLine =+ moveMWhileKeepingSelection $+ nonEmptyCursorSelectPrev rebuildTextCursor unsafeMakeTextCursor++textFieldCursorSelectNextLine :: TextFieldCursor -> Maybe TextFieldCursor+textFieldCursorSelectNextLine =+ moveMWhileKeepingSelection $+ nonEmptyCursorSelectNext rebuildTextCursor unsafeMakeTextCursor++moveMWhileKeepingSelection ::+ (NonEmptyCursor TextCursor Text -> Maybe (NonEmptyCursor TextCursor Text))+ -> TextFieldCursor+ -> Maybe TextFieldCursor+moveMWhileKeepingSelection movement tfc = do+ let i = textFieldCursorIndexOnLine tfc+ let tfc' = textFieldCursorSelectIndexOnLine 0 tfc+ tfc'' <- textFieldCursorNonEmptyCursorL movement $ tfc'+ pure $ textFieldCursorSelectIndexOnLine i tfc''++textFieldCursorSelectFirstLine :: TextFieldCursor -> TextFieldCursor+textFieldCursorSelectFirstLine =+ moveWhileKeepingSelection $+ nonEmptyCursorSelectFirst rebuildTextCursor unsafeMakeTextCursor++textFieldCursorSelectLastLine :: TextFieldCursor -> TextFieldCursor+textFieldCursorSelectLastLine =+ moveWhileKeepingSelection $+ nonEmptyCursorSelectLast rebuildTextCursor unsafeMakeTextCursor++moveWhileKeepingSelection ::+ (NonEmptyCursor TextCursor Text -> NonEmptyCursor TextCursor Text)+ -> TextFieldCursor+ -> TextFieldCursor+moveWhileKeepingSelection movement tfc =+ let i = textFieldCursorIndexOnLine tfc+ tfc' = textFieldCursorSelectIndexOnLine 0 tfc+ tfc'' = tfc' & textFieldCursorNonEmptyCursorL %~ movement+ in textFieldCursorSelectIndexOnLine i tfc''++textFieldCursorSelectPrevChar :: TextFieldCursor -> Maybe TextFieldCursor+textFieldCursorSelectPrevChar = textFieldCursorSelectedL textCursorSelectPrev++textFieldCursorSelectNextChar :: TextFieldCursor -> Maybe TextFieldCursor+textFieldCursorSelectNextChar = textFieldCursorSelectedL textCursorSelectNext++textFieldCursorIndexOnLine :: TextFieldCursor -> Int+textFieldCursorIndexOnLine tfc =+ textCursorIndex $ tfc ^. textFieldCursorSelectedL++textFieldCursorSelectIndexOnLine :: Int -> TextFieldCursor -> TextFieldCursor+textFieldCursorSelectIndexOnLine ix_ =+ textFieldCursorSelectedL %~ textCursorSelectIndex ix_++textFieldCursorInsertChar :: Char -> Maybe TextFieldCursor -> TextFieldCursor+textFieldCursorInsertChar c mtfc =+ case c of+ '\n' -> textFieldCursorInsertNewline mtfc+ _ ->+ (fromMaybe emptyTextFieldCursor mtfc) &+ textFieldCursorSelectedL %~ (fromJust . textCursorInsert c)++textFieldCursorAppendChar :: Char -> Maybe TextFieldCursor -> TextFieldCursor+textFieldCursorAppendChar c mtfc =+ case c of+ '\n' -> textFieldCursorAppendNewline mtfc+ _ ->+ (fromMaybe emptyTextFieldCursor mtfc) &+ textFieldCursorSelectedL %~ (fromJust . textCursorAppend c)++textFieldCursorInsertNewline :: Maybe TextFieldCursor -> TextFieldCursor+textFieldCursorInsertNewline mtfc =+ let tfc = fromMaybe emptyTextFieldCursor mtfc+ in tfc &+ textFieldCursorNonEmptyCursorL %~+ (\lec@NonEmptyCursor {..} ->+ let (tc1, tc2) = textCursorSplit nonEmptyCursorCurrent+ in lec+ { nonEmptyCursorPrev =+ rebuildTextCursor tc1 : nonEmptyCursorPrev+ , nonEmptyCursorCurrent = tc2+ })++textFieldCursorAppendNewline :: Maybe TextFieldCursor -> TextFieldCursor+textFieldCursorAppendNewline mtfc =+ let tfc = fromMaybe emptyTextFieldCursor mtfc+ in tfc &+ textFieldCursorNonEmptyCursorL %~+ (\lec@NonEmptyCursor {..} ->+ let (tc1, tc2) = textCursorSplit nonEmptyCursorCurrent+ in lec+ { nonEmptyCursorCurrent = tc1+ , nonEmptyCursorNext =+ rebuildTextCursor tc2 : nonEmptyCursorNext+ })++textFieldCursorRemove ::+ TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)+textFieldCursorRemove tfc =+ if nullTextFieldCursor tfc+ then Just Deleted+ else focusPossibleDeleteOrUpdate+ textFieldCursorNonEmptyCursorL+ (\lec@NonEmptyCursor {..} ->+ case textCursorRemove nonEmptyCursorCurrent of+ Nothing ->+ case nonEmptyCursorPrev of+ [] -> Nothing+ (pl:pls) ->+ Just $+ Updated $+ lec+ { nonEmptyCursorPrev = pls+ , nonEmptyCursorCurrent =+ textCursorCombine+ (unsafeMakeTextCursor pl)+ nonEmptyCursorCurrent+ }+ Just ctc ->+ Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc)+ tfc++textFieldCursorDelete ::+ TextFieldCursor -> Maybe (DeleteOrUpdate TextFieldCursor)+textFieldCursorDelete tfc =+ if nullTextFieldCursor tfc+ then Just Deleted+ else focusPossibleDeleteOrUpdate+ textFieldCursorNonEmptyCursorL+ (\lec@NonEmptyCursor {..} ->+ case textCursorDelete nonEmptyCursorCurrent of+ Nothing ->+ case nonEmptyCursorNext of+ [] -> Nothing+ (pl:pls) ->+ Just $+ Updated $+ lec+ { nonEmptyCursorCurrent =+ textCursorCombine+ nonEmptyCursorCurrent+ (unsafeMakeTextCursor pl)+ , nonEmptyCursorNext = pls+ }+ Just ctc ->+ Just $ Updated $ lec & nonEmptyCursorElemL .~ ctc)+ tfc++textFieldCursorSelectStartOfLine :: TextFieldCursor -> TextFieldCursor+textFieldCursorSelectStartOfLine =+ textFieldCursorSelectedL %~ textCursorSelectStart++textFieldCursorSelectEndOfLine :: TextFieldCursor -> TextFieldCursor+textFieldCursorSelectEndOfLine = textFieldCursorSelectedL %~ textCursorSelectEnd++-- Unsafe: only use for movements.+unsafeMakeTextCursor :: Text -> TextCursor+unsafeMakeTextCursor = fromJust . makeTextCursor
+ src/Cursor/Tree.hs view
@@ -0,0 +1,37 @@+{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}++module Cursor.Tree+ ( TreeCursor(..)+ , TreeAbove(..)+ -- * Types+ , module Cursor.Tree.Types+ -- * Construction, destruction+ , module Cursor.Tree.Base+ -- * Drawing+ , module Cursor.Tree.Draw+ -- * Collapsing+ , module Cursor.Tree.Collapse+ -- * Movements+ , module Cursor.Tree.Movement+ -- * Insertions+ , module Cursor.Tree.Insert+ -- * Deletions+ , module Cursor.Tree.Delete+ -- * Swapping+ , module Cursor.Tree.Swap+ -- * Promotions+ , module Cursor.Tree.Promote+ -- * Demotions+ , module Cursor.Tree.Demote+ ) where++import Cursor.Tree.Base+import Cursor.Tree.Delete+import Cursor.Tree.Demote+import Cursor.Tree.Draw+import Cursor.Tree.Insert+import Cursor.Tree.Collapse+import Cursor.Tree.Movement+import Cursor.Tree.Promote+import Cursor.Tree.Swap+import Cursor.Tree.Types
+ src/Cursor/Tree/Base.hs view
@@ -0,0 +1,74 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Base+ ( singletonTreeCursor+ , makeTreeCursor+ , makeTreeCursorWithSelection+ , rebuildTreeCursor+ , mapTreeCursor+ , currentTree+ , makeTreeCursorWithAbove+ ) where++import Cursor.Tree.Types++singletonTreeCursor :: a -> TreeCursor a b+singletonTreeCursor v =+ TreeCursor {treeAbove = Nothing, treeCurrent = v, treeBelow = emptyCForest}++makeTreeCursor :: (b -> a) -> CTree b -> TreeCursor a b+makeTreeCursor g (CNode v fs) =+ TreeCursor {treeAbove = Nothing, treeCurrent = g v, treeBelow = fs}++makeTreeCursorWithSelection ::+ (a -> b)+ -> (b -> a)+ -> TreeCursorSelection+ -> CTree b+ -> Maybe (TreeCursor a b)+makeTreeCursorWithSelection f g sel = walkDown sel . makeTreeCursor g+ where+ walkDown SelectNode tc = pure tc+ walkDown (SelectChild i s) TreeCursor {..} =+ (walkDown s =<<) $+ case splitAt i $ unpackCForest treeBelow of+ (_, []) -> Nothing+ (lefts, current:rights) ->+ Just $+ makeTreeCursorWithAbove g current $+ Just $+ TreeAbove+ { treeAboveLefts = reverse lefts+ , treeAboveAbove = treeAbove+ , treeAboveNode = f treeCurrent+ , treeAboveRights = rights+ }++rebuildTreeCursor :: (a -> b) -> TreeCursor a b -> CTree b+rebuildTreeCursor f TreeCursor {..} =+ wrapAbove treeAbove $ CNode (f treeCurrent) treeBelow+ where+ wrapAbove Nothing t = t+ wrapAbove (Just TreeAbove {..}) t =+ wrapAbove treeAboveAbove $+ CNode treeAboveNode $+ openForest $ concat [reverse treeAboveLefts, [t], treeAboveRights]++mapTreeCursor :: (a -> c) -> (b -> d) -> TreeCursor a b -> TreeCursor c d+mapTreeCursor f g TreeCursor {..} =+ TreeCursor+ { treeAbove = fmap g <$> treeAbove+ , treeCurrent = f treeCurrent+ , treeBelow = fmap g treeBelow+ }++currentTree :: (a -> b) -> TreeCursor a b -> CTree b+currentTree f TreeCursor {..} = CNode (f treeCurrent) treeBelow++makeTreeCursorWithAbove ::+ (b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b+makeTreeCursorWithAbove g (CNode a forest) mta =+ TreeCursor {treeAbove = mta, treeCurrent = g a, treeBelow = forest}
+ src/Cursor/Tree/Collapse.hs view
@@ -0,0 +1,34 @@+module Cursor.Tree.Collapse+ ( treeCursorCloseCurrentForest+ , treeCursorOpenCurrentForest+ , treeCursorToggleCurrentForest+ ) where++import qualified Data.List.NonEmpty as NE++import Cursor.Tree.Types++treeCursorOpenCurrentForest :: TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorOpenCurrentForest tc =+ case treeBelow tc of+ EmptyCForest -> Nothing+ ClosedForest ts ->+ Just $ tc {treeBelow = OpenForest $ NE.map makeCTree ts}+ OpenForest _ -> Nothing++treeCursorCloseCurrentForest :: TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorCloseCurrentForest tc =+ case treeBelow tc of+ EmptyCForest -> Nothing+ ClosedForest _ -> Nothing+ OpenForest ts ->+ Just $ tc {treeBelow = ClosedForest $ NE.map rebuildCTree ts}++treeCursorToggleCurrentForest :: TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorToggleCurrentForest tc =+ case treeBelow tc of+ EmptyCForest -> Nothing+ ClosedForest ts ->+ Just $ tc {treeBelow = OpenForest $ NE.map makeCTree ts}+ OpenForest ts ->+ Just $ tc {treeBelow = ClosedForest $ NE.map rebuildCTree ts}
+ src/Cursor/Tree/Delete.hs view
@@ -0,0 +1,179 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Delete+ ( treeCursorDeleteSubTreeAndSelectPrevious+ , treeCursorDeleteSubTreeAndSelectNext+ , treeCursorDeleteSubTreeAndSelectAbove+ , treeCursorRemoveSubTree+ , treeCursorDeleteSubTree+ , treeCursorDeleteElemAndSelectPrevious+ , treeCursorDeleteElemAndSelectNext+ , treeCursorDeleteElemAndSelectAbove+ , treeCursorRemoveElem+ , treeCursorDeleteElem+ ) where++import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Tree++import Control.Applicative++import Cursor.Tree.Base+import Cursor.Tree.Types+import Cursor.Types++treeCursorDeleteSubTreeAndSelectPrevious ::+ (b -> a) -> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))+treeCursorDeleteSubTreeAndSelectPrevious g TreeCursor {..} =+ case treeAbove of+ Nothing -> Just Deleted+ Just ta ->+ case treeAboveLefts ta of+ [] -> Nothing+ tree:xs ->+ Just . Updated . makeTreeCursorWithAbove g tree $+ Just ta {treeAboveLefts = xs}++treeCursorDeleteSubTreeAndSelectNext ::+ (b -> a) -> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))+treeCursorDeleteSubTreeAndSelectNext g TreeCursor {..} =+ case treeAbove of+ Nothing -> Just Deleted+ Just ta ->+ case treeAboveRights ta of+ [] -> Nothing+ tree:xs ->+ Just . Updated . makeTreeCursorWithAbove g tree $+ Just ta {treeAboveRights = xs}++treeCursorDeleteSubTreeAndSelectAbove ::+ (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)+treeCursorDeleteSubTreeAndSelectAbove g TreeCursor {..} =+ case treeAbove of+ Nothing -> Deleted+ Just TreeAbove {..} ->+ Updated $+ TreeCursor+ { treeAbove = treeAboveAbove+ , treeCurrent = g treeAboveNode+ , treeBelow = openForest $ reverse treeAboveLefts ++ treeAboveRights+ }++treeCursorRemoveSubTree ::+ (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)+treeCursorRemoveSubTree g tc =+ joinDeletes+ (treeCursorDeleteSubTreeAndSelectPrevious g tc)+ (treeCursorDeleteSubTreeAndSelectNext g tc) <|>+ treeCursorDeleteSubTreeAndSelectAbove g tc++treeCursorDeleteSubTree ::+ (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)+treeCursorDeleteSubTree g tc =+ joinDeletes+ (treeCursorDeleteSubTreeAndSelectNext g tc)+ (treeCursorDeleteSubTreeAndSelectPrevious g tc) <|>+ treeCursorDeleteSubTreeAndSelectAbove g tc++treeCursorDeleteElemAndSelectPrevious ::+ (b -> a) -> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))+treeCursorDeleteElemAndSelectPrevious g TreeCursor {..} =+ case treeAbove of+ Nothing ->+ case treeBelow of+ EmptyCForest -> Just Deleted+ _ -> Nothing+ Just ta ->+ case treeAboveLefts ta of+ [] -> Nothing+ tree:xs ->+ Just . Updated . makeTreeCursorWithAbove g tree $+ Just+ ta+ { treeAboveLefts = xs+ , treeAboveRights =+ unpackCForest treeBelow ++ treeAboveRights ta+ }++treeCursorDeleteElemAndSelectNext ::+ (b -> a) -> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))+treeCursorDeleteElemAndSelectNext g TreeCursor {..} =+ case treeBelow of+ EmptyCForest ->+ case treeAbove of+ Nothing -> Just Deleted+ Just ta ->+ case treeAboveRights ta of+ [] -> Nothing+ tree:xs ->+ Just . Updated . makeTreeCursorWithAbove g tree $+ Just ta {treeAboveRights = xs}+ ClosedForest ts ->+ case treeAbove of+ Nothing ->+ case ts of+ (Node e ts_ :| xs) ->+ let t = CNode e $ closedForest $ ts_ ++ xs+ in Just . Updated $+ makeTreeCursorWithAbove g t treeAbove+ Just ta ->+ case treeAboveRights ta of+ [] -> Nothing+ tree:xs ->+ Just . Updated . makeTreeCursorWithAbove g tree $+ Just+ ta+ { treeAboveLefts =+ map makeCTree (reverse $ NE.toList ts) +++ treeAboveLefts ta+ , treeAboveRights = xs+ }+ OpenForest (CNode e ts :| xs) ->+ let t =+ CNode e $+ case ts of+ EmptyCForest -> openForest xs+ OpenForest ts_ -> openForest $ NE.toList ts_ ++ xs+ ClosedForest ts_ ->+ closedForest $ NE.toList ts_ ++ map rebuildCTree xs+ in Just . Updated $ makeTreeCursorWithAbove g t treeAbove++treeCursorDeleteElemAndSelectAbove ::+ (b -> a) -> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b))+treeCursorDeleteElemAndSelectAbove g TreeCursor {..} =+ case treeAbove of+ Nothing ->+ case treeBelow of+ EmptyCForest -> Just Deleted+ _ -> Nothing+ Just TreeAbove {..} ->+ Just $+ Updated $+ TreeCursor+ { treeAbove = treeAboveAbove+ , treeCurrent = g treeAboveNode+ , treeBelow =+ openForest $+ reverse treeAboveLefts +++ unpackCForest treeBelow ++ treeAboveRights+ }++treeCursorRemoveElem ::+ (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)+treeCursorRemoveElem g tc =+ joinDeletes3+ (treeCursorDeleteElemAndSelectPrevious g tc)+ (treeCursorDeleteElemAndSelectNext g tc)+ (treeCursorDeleteElemAndSelectAbove g tc)++treeCursorDeleteElem ::+ (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b)+treeCursorDeleteElem g tc =+ joinDeletes3+ (treeCursorDeleteElemAndSelectNext g tc)+ (treeCursorDeleteElemAndSelectPrevious g tc)+ (treeCursorDeleteElemAndSelectAbove g tc)
+ src/Cursor/Tree/Demote.hs view
@@ -0,0 +1,172 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Demote+ ( treeCursorDemoteElem+ , treeCursorDemoteSubTree+ , DemoteResult(..)+ , treeCursorDemoteElemUnder+ , treeCursorDemoteSubTreeUnder+ ) where++import Data.Validity++import GHC.Generics (Generic)++import Cursor.Tree.Base+import Cursor.Tree.Types++-- | Demotes the current node to the level of its children.+--+-- Example:+--+-- Before:+--+-- > p+-- > |- a+-- > | |- b+-- > |- c <--+-- > | |- d+-- > |- e+--+-- After:+--+-- > p+-- > |- a+-- > | |- b+-- > | |- c <--+-- > | |- d+-- > |- e+treeCursorDemoteElem ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)+treeCursorDemoteElem f g tc =+ case treeAbove tc of+ Nothing -> CannotDemoteTopNode+ Just ta ->+ case treeAboveLefts ta of+ [] -> NoSiblingsToDemoteUnder+ (CNode t ls:ts) ->+ Demoted $+ makeTreeCursorWithAbove+ g+ (CNode (f $ treeCurrent tc) emptyCForest) $+ Just+ TreeAbove+ { treeAboveLefts = reverse $ unpackCForest ls+ , treeAboveAbove = Just ta {treeAboveLefts = ts}+ , treeAboveNode = t+ , treeAboveRights = unpackCForest $ treeBelow tc+ }++-- | Demotes the current subtree to the level of its children.+--+-- Example:+--+-- Before:+--+-- > p+-- > |- a+-- > | |- b+-- > |- c <--+-- > | |- d+-- > |- e+--+-- After:+--+-- > p+-- > |- a+-- > | |- b+-- > | |- c <--+-- > | |- d+-- > |- e+treeCursorDemoteSubTree ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b)+treeCursorDemoteSubTree f g tc =+ case treeAbove tc of+ Nothing -> CannotDemoteTopNode+ Just ta ->+ case treeAboveLefts ta of+ [] -> NoSiblingsToDemoteUnder+ (CNode t ls:ts) ->+ Demoted $+ makeTreeCursorWithAbove g (currentTree f tc) $+ Just+ TreeAbove+ { treeAboveLefts = reverse $ unpackCForest ls+ , treeAboveAbove = Just ta {treeAboveLefts = ts}+ , treeAboveNode = t+ , treeAboveRights = []+ }++data DemoteResult a+ = CannotDemoteTopNode+ | NoSiblingsToDemoteUnder+ | Demoted a+ deriving (Show, Eq, Generic, Functor)++instance Validity a => Validity (DemoteResult a)++-- | Demotes the current node to the level of its children, by adding two roots.+-- One for the current node and one for its children that are left behind.+--+-- Example:+--+-- Before:+--+-- > p+-- > |- a <--+-- > |- b+--+-- After:+--+-- > p+-- > |- <given element 1>+-- > | |- a <--+-- > |- <given element 2>+-- > | |- b+treeCursorDemoteElemUnder :: b -> b -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorDemoteElemUnder b1 b2 tc = do+ ta <- treeAbove tc+ let ta' =+ ta {treeAboveRights = CNode b2 (treeBelow tc) : treeAboveRights ta}+ pure+ tc+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts = []+ , treeAboveAbove = Just ta'+ , treeAboveNode = b1+ , treeAboveRights = []+ }+ , treeBelow = emptyCForest+ }++-- | Demotes the current subtree to the level of its children, by adding a root.+--+-- Example:+--+-- Before:+--+-- > a <--+-- > |- b+--+-- After:+--+-- > <given element>+-- > |- a <--+-- > |- b+treeCursorDemoteSubTreeUnder :: b -> TreeCursor a b -> TreeCursor a b+treeCursorDemoteSubTreeUnder b tc =+ tc+ { treeAbove =+ Just+ TreeAbove+ { treeAboveLefts = []+ , treeAboveAbove = treeAbove tc+ , treeAboveNode = b+ , treeAboveRights = []+ }+ }
+ src/Cursor/Tree/Draw.hs view
@@ -0,0 +1,52 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Draw+ ( drawTreeCursor+ , treeCursorWithPointer+ , showCForest+ , showCTree+ , showForest+ , showTree+ ) where++import qualified Data.List.NonEmpty as NE+import Data.Tree++import Cursor.Tree.Types++drawTreeCursor :: (Show a, Show b) => TreeCursor a b -> String+drawTreeCursor = drawTree . treeCursorWithPointer++treeCursorWithPointer :: (Show a, Show b) => TreeCursor a b -> Tree String+treeCursorWithPointer TreeCursor {..} =+ wrapAbove treeAbove $+ Node (show treeCurrent ++ " <---") $ showCForest treeBelow+ where+ wrapAbove :: (Show b) => Maybe (TreeAbove b) -> Tree String -> Tree String+ wrapAbove Nothing t = t+ wrapAbove (Just TreeAbove {..}) t =+ wrapAbove treeAboveAbove $+ Node (show treeAboveNode) $+ concat+ [ map showCTree $ reverse treeAboveLefts+ , [t]+ , map showCTree treeAboveRights+ ]++showCForest :: Show a => CForest a -> Forest String+showCForest EmptyCForest = []+showCForest (ClosedForest ts) =+ map (fmap ("hidden: " ++)) $ map showTree $ NE.toList ts+showCForest (OpenForest ts) = map showCTree $ NE.toList ts++showCTree :: Show a => CTree a -> Tree String+showCTree (CNode n fs) = Node (show n) $ showCForest fs++showForest :: Show a => Forest a -> Forest String+showForest = map showTree++showTree :: Show a => Tree a -> Tree String+showTree = fmap show
+ src/Cursor/Tree/Insert.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Insert+ ( treeCursorInsert+ , treeCursorInsertAndSelect+ , treeCursorAppend+ , treeCursorAppendAndSelect+ , treeCursorAddChildAtPos+ , treeCursorAddChildAtStart+ , treeCursorAddChildAtEnd+ ) where++import qualified Data.List.NonEmpty as NE+import Data.List.NonEmpty ((<|))+import Data.Tree++import Cursor.Tree.Base+import Cursor.Tree.Types++treeCursorInsert :: Tree b -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorInsert tree tc@TreeCursor {..} = do+ ta <- treeAbove+ let newTreeAbove = ta {treeAboveLefts = makeCTree tree : treeAboveLefts ta}+ pure tc {treeAbove = Just newTreeAbove}++treeCursorInsertAndSelect ::+ (a -> b)+ -> (b -> a)+ -> Tree b+ -> TreeCursor a b+ -> Maybe (TreeCursor a b)+treeCursorInsertAndSelect f g tree tc@TreeCursor {..} = do+ ta <- treeAbove+ let newTreeAbove =+ ta {treeAboveRights = currentTree f tc : treeAboveRights ta}+ pure $ makeTreeCursorWithAbove g (makeCTree tree) $ Just newTreeAbove++treeCursorAppend :: Tree b -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorAppend tree tc@TreeCursor {..} = do+ ta <- treeAbove+ let newTreeAbove =+ ta {treeAboveRights = makeCTree tree : treeAboveRights ta}+ pure tc {treeAbove = Just newTreeAbove}++treeCursorAppendAndSelect ::+ (a -> b)+ -> (b -> a)+ -> Tree b+ -> TreeCursor a b+ -> Maybe (TreeCursor a b)+treeCursorAppendAndSelect f g tree tc@TreeCursor {..} = do+ ta <- treeAbove+ let newTreeAbove =+ ta {treeAboveLefts = currentTree f tc : treeAboveLefts ta}+ pure $ makeTreeCursorWithAbove g (makeCTree tree) $ Just newTreeAbove++-- TODO make this fail if the position doesn't make sense+treeCursorAddChildAtPos :: Int -> Tree b -> TreeCursor a b -> TreeCursor a b+treeCursorAddChildAtPos i t tc =+ case treeBelow tc of+ EmptyCForest -> tc {treeBelow = openForest [makeCTree t]}+ ClosedForest ts ->+ let (before, after) = splitAt i $ NE.toList ts+ in tc+ {treeBelow = openForest $ map makeCTree $ before ++ [t] ++ after}+ OpenForest ts ->+ let (before, after) = splitAt i $ NE.toList ts+ in tc {treeBelow = openForest $ before ++ [makeCTree t] ++ after}++treeCursorAddChildAtStart :: Tree b -> TreeCursor a b -> TreeCursor a b+treeCursorAddChildAtStart t tc =+ case treeBelow tc of+ EmptyCForest -> tc {treeBelow = openForest [makeCTree t]}+ ClosedForest ts ->+ tc {treeBelow = OpenForest $ NE.map makeCTree $ t <| ts}+ OpenForest ts -> tc {treeBelow = OpenForest $ makeCTree t <| ts}++treeCursorAddChildAtEnd :: Tree b -> TreeCursor a b -> TreeCursor a b+treeCursorAddChildAtEnd t tc =+ case treeBelow tc of+ EmptyCForest -> tc {treeBelow = openForest [makeCTree t]}+ ClosedForest ts ->+ tc {treeBelow = openForest $ map makeCTree $ NE.toList ts ++ [t]}+ OpenForest ts ->+ tc {treeBelow = openForest $ NE.toList ts ++ [makeCTree t]}
+ src/Cursor/Tree/Movement.hs view
@@ -0,0 +1,187 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Movement+ ( treeCursorSelection+ , TreeCursorSelection(..)+ , treeCursorSelect+ , treeCursorSelectPrev+ , treeCursorSelectNext+ , treeCursorSelectFirst+ , treeCursorSelectLast+ , treeCursorSelectAbove+ , treeCursorSelectBelowAtPos+ , treeCursorSelectBelowAtStart+ , treeCursorSelectBelowAtEnd+ , treeCursorSelectBelowAtStartRecursively+ , treeCursorSelectBelowAtEndRecursively+ , treeCursorSelectPrevOnSameLevel+ , treeCursorSelectNextOnSameLevel+ , treeCursorSelectAbovePrev+ , treeCursorSelectAboveNext+ ) where++import qualified Data.List.NonEmpty as NE+import Data.Validity.Tree ()++import Control.Applicative+import Control.Monad++import Cursor.Tree.Base+import Cursor.Tree.Types++treeCursorSelection :: TreeCursor a b -> TreeCursorSelection+treeCursorSelection TreeCursor {..} = wrap treeAbove SelectNode+ where+ wrap :: Maybe (TreeAbove a) -> TreeCursorSelection -> TreeCursorSelection+ wrap Nothing ts = ts+ wrap (Just ta) ts =+ wrap (treeAboveAbove ta) $ SelectChild (length $ treeAboveLefts ta) ts++treeCursorSelect ::+ (a -> b)+ -> (b -> a)+ -> TreeCursorSelection+ -> TreeCursor a b+ -> Maybe (TreeCursor a b)+treeCursorSelect f g sel =+ makeTreeCursorWithSelection f g sel . rebuildTreeCursor f++treeCursorSelectPrev ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectPrev f g tc =+ treeCursorSelectAbovePrev f g tc <|> treeCursorSelectPrevOnSameLevel f g tc <|>+ treeCursorSelectAbove f g tc++treeCursorSelectNext ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectNext f g tc =+ treeCursorSelectBelowAtStart f g tc <|>+ treeCursorSelectNextOnSameLevel f g tc <|>+ treeCursorSelectAboveNext f g tc++treeCursorSelectFirst ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> TreeCursor a b+treeCursorSelectFirst f g tc =+ maybe tc (treeCursorSelectFirst f g) $ treeCursorSelectPrev f g tc++treeCursorSelectLast :: (a -> b) -> (b -> a) -> TreeCursor a b -> TreeCursor a b+treeCursorSelectLast f g tc =+ maybe tc (treeCursorSelectLast f g) $ treeCursorSelectNext f g tc++treeCursorSelectAbove ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectAbove f g tc@TreeCursor {..} =+ case treeAbove of+ Nothing -> Nothing+ Just TreeAbove {..} ->+ let newForest =+ (reverse treeAboveLefts) +++ [currentTree f tc] ++ treeAboveRights+ newTree = CNode treeAboveNode $ openForest newForest+ in Just $ makeTreeCursorWithAbove g newTree treeAboveAbove++treeCursorSelectBelowAtPos ::+ (a -> b) -> (b -> a) -> Int -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectBelowAtPos f g pos TreeCursor {..} =+ case treeBelow of+ EmptyCForest -> Nothing+ ClosedForest _ -> Nothing+ OpenForest ts ->+ case splitAt pos $ NE.toList ts of+ (_, []) -> Nothing+ (lefts, current:rights) ->+ Just $+ makeTreeCursorWithAbove g current $+ Just $+ TreeAbove+ { treeAboveLefts = reverse lefts+ , treeAboveAbove = treeAbove+ , treeAboveNode = f treeCurrent+ , treeAboveRights = rights+ }++treeCursorSelectBelowAtStart ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectBelowAtStart f g = treeCursorSelectBelowAtPos f g 0++treeCursorSelectBelowAtEnd ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectBelowAtEnd f g tc =+ case treeBelow tc of+ EmptyCForest -> Nothing+ ClosedForest _ -> Nothing+ OpenForest ts -> treeCursorSelectBelowAtPos f g (length ts - 1) tc++treeCursorSelectBelowAtStartRecursively ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectBelowAtStartRecursively f g tc =+ go <$> treeCursorSelectBelowAtStart f g tc+ where+ go c = maybe c go $ treeCursorSelectBelowAtStart f g c++treeCursorSelectBelowAtEndRecursively ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectBelowAtEndRecursively f g tc =+ go <$> treeCursorSelectBelowAtEnd f g tc+ where+ go c = maybe c go $ treeCursorSelectBelowAtEnd f g c++treeCursorSelectPrevOnSameLevel ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectPrevOnSameLevel f g tc@TreeCursor {..} = do+ ta <- treeAbove+ case treeAboveLefts ta of+ [] -> Nothing+ tree:xs ->+ Just . makeTreeCursorWithAbove g tree $+ Just+ ta+ { treeAboveLefts = xs+ , treeAboveRights = currentTree f tc : treeAboveRights ta+ }++treeCursorSelectNextOnSameLevel ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectNextOnSameLevel f g tc@TreeCursor {..} = do+ ta <- treeAbove+ case treeAboveRights ta of+ [] -> Nothing+ tree:xs ->+ Just . makeTreeCursorWithAbove g tree . Just $+ ta+ { treeAboveLefts = currentTree f tc : treeAboveLefts ta+ , treeAboveRights = xs+ }++-- | Go back and down as far as necessary to find a previous element on a level below+treeCursorSelectAbovePrev ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectAbovePrev f g =+ treeCursorSelectPrevOnSameLevel f g >=>+ treeCursorSelectBelowAtEndRecursively f g++-- | Go up as far as necessary to find a next element on a level above and forward+--+-- Note: This will fail if there is a next node on the same level or any node below the current node+treeCursorSelectAboveNext ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b)+treeCursorSelectAboveNext f g tc =+ case treeCursorSelectNextOnSameLevel f g tc of+ Just _ -> Nothing+ Nothing ->+ case treeBelow tc of+ EmptyCForest -> go tc+ ClosedForest _ -> go tc+ OpenForest ts ->+ if null ts+ then go tc+ else Nothing+ where+ go tc_ = do+ tc' <- treeCursorSelectAbove f g tc_+ case treeCursorSelectNextOnSameLevel f g tc' of+ Nothing -> go tc'+ Just tc'' -> pure tc''
+ src/Cursor/Tree/Promote.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Promote+ ( treeCursorPromoteElem+ , PromoteElemResult(..)+ , treeCursorPromoteSubTree+ , PromoteResult(..)+ ) where++import Data.Validity++import GHC.Generics (Generic)++import Cursor.Tree.Base+import Cursor.Tree.Types++-- | Promotes the current node to the level of its parent.+--+-- Example:+--+-- Before:+--+-- > p+-- > |- a+-- > | |- b+-- > | | |- c+-- > | |- d <--+-- > | | |- e+-- > | |- f+-- > | |- g+-- > |- h+--+-- After:+--+-- > p+-- > |- a+-- > | |- b+-- > | | |- c+-- > | | |- e+-- > | |- f+-- > | |- g+-- > |- d <--+-- > |- h+treeCursorPromoteElem ::+ (a -> b)+ -> (b -> a)+ -> TreeCursor a b+ -> PromoteElemResult (TreeCursor a b)+treeCursorPromoteElem f g tc = do+ ta <-+ case treeAbove tc of+ Nothing -> CannotPromoteTopElem+ Just ta -> pure ta+ -- We need to put the below under the above lefts at the end+ lefts <-+ case (treeBelow tc) of+ EmptyCForest -> pure $ treeAboveLefts ta+ _ ->+ case treeAboveLefts ta of+ [] -> NoSiblingsToAdoptChildren+ (CNode t ls:ts) ->+ pure $+ CNode+ t+ (openForest $+ unpackCForest ls ++ unpackCForest (treeBelow tc)) :+ ts+ taa <-+ case treeAboveAbove ta of+ Nothing -> NoGrandparentToPromoteElemUnder+ Just taa -> pure taa+ pure $+ makeTreeCursorWithAbove g (CNode (f $ treeCurrent tc) emptyCForest) $+ Just $+ taa+ { treeAboveLefts =+ CNode+ (treeAboveNode ta)+ (openForest $ reverse lefts ++ treeAboveRights ta) :+ treeAboveLefts taa+ }++data PromoteElemResult a+ = CannotPromoteTopElem+ | NoGrandparentToPromoteElemUnder+ | NoSiblingsToAdoptChildren+ | PromotedElem a+ deriving (Show, Eq, Generic, Functor)++instance Validity a => Validity (PromoteElemResult a)++instance Applicative PromoteElemResult where+ pure = PromotedElem+ CannotPromoteTopElem <*> _ = CannotPromoteTopElem+ NoGrandparentToPromoteElemUnder <*> _ = NoGrandparentToPromoteElemUnder+ NoSiblingsToAdoptChildren <*> _ = NoSiblingsToAdoptChildren+ PromotedElem f <*> PromotedElem a = PromotedElem $ f a+ PromotedElem _ <*> CannotPromoteTopElem = CannotPromoteTopElem+ PromotedElem _ <*> NoSiblingsToAdoptChildren = NoSiblingsToAdoptChildren+ PromotedElem _ <*> NoGrandparentToPromoteElemUnder =+ NoGrandparentToPromoteElemUnder++instance Monad PromoteElemResult where+ CannotPromoteTopElem >>= _ = CannotPromoteTopElem+ NoGrandparentToPromoteElemUnder >>= _ = NoGrandparentToPromoteElemUnder+ NoSiblingsToAdoptChildren >>= _ = NoSiblingsToAdoptChildren+ PromotedElem a >>= f = f a++-- | Promotes the current node to the level of its parent.+--+-- Example:+--+-- Before:+--+-- > p+-- > |- a+-- > | |- b+-- > | | |- c+-- > | |- d <--+-- > | | |- e+-- > | |- f+-- > | |- g+-- > |- h+--+-- After:+--+-- > p+-- > |- a+-- > | |- b+-- > | | |- c+-- > | |- f+-- > | |- g+-- > |- d <--+-- > | |- e+-- > |- h+treeCursorPromoteSubTree ::+ (a -> b) -> (b -> a) -> TreeCursor a b -> PromoteResult (TreeCursor a b)+treeCursorPromoteSubTree f g tc = do+ ta <-+ case treeAbove tc of+ Nothing -> CannotPromoteTopNode+ Just ta -> pure ta+ taa <-+ case treeAboveAbove ta of+ Nothing -> NoGrandparentToPromoteUnder+ Just taa -> pure taa+ pure $+ makeTreeCursorWithAbove g (currentTree f tc) $+ Just $+ taa+ { treeAboveLefts =+ CNode+ (treeAboveNode ta)+ (openForest $+ reverse (treeAboveLefts ta) ++ treeAboveRights ta) :+ treeAboveLefts taa+ }++data PromoteResult a+ = CannotPromoteTopNode+ | NoGrandparentToPromoteUnder+ | Promoted a+ deriving (Show, Eq, Generic, Functor)++instance Validity a => Validity (PromoteResult a)++instance Applicative PromoteResult where+ pure = Promoted+ CannotPromoteTopNode <*> _ = CannotPromoteTopNode+ NoGrandparentToPromoteUnder <*> _ = NoGrandparentToPromoteUnder+ Promoted f <*> Promoted a = Promoted $ f a+ Promoted _ <*> CannotPromoteTopNode = CannotPromoteTopNode+ Promoted _ <*> NoGrandparentToPromoteUnder = NoGrandparentToPromoteUnder++instance Monad PromoteResult where+ CannotPromoteTopNode >>= _ = CannotPromoteTopNode+ NoGrandparentToPromoteUnder >>= _ = NoGrandparentToPromoteUnder+ Promoted a >>= f = f a
+ src/Cursor/Tree/Swap.hs view
@@ -0,0 +1,90 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Swap+ ( treeCursorSwapPrev+ , treeCursorSwapNext+ , SwapResult(..)+ ) where++import Data.Validity++import GHC.Generics (Generic)++import Cursor.Tree.Types++-- | Swaps the current node with the previous node on the same level+--+-- Example:+--+-- Before:+--+-- > p+-- > |- a+-- > |- b <--+--+-- After:+--+-- > p+-- > |- b <--+-- > |- a+treeCursorSwapPrev :: TreeCursor a b -> SwapResult (TreeCursor a b)+treeCursorSwapPrev tc = do+ case treeAbove tc of+ Nothing -> SwapperIsTopNode+ Just ta ->+ case treeAboveLefts ta of+ [] -> NoSiblingsToSwapWith+ (t:ts) ->+ Swapped $+ tc+ { treeAbove =+ Just+ ta+ { treeAboveLefts = ts+ , treeAboveRights = t : treeAboveRights ta+ }+ }++-- | Swaps the current node with the next node on the same level+--+-- Example:+--+-- Before:+--+-- > p+-- > |- a <--+-- > |- b+--+-- After:+--+-- > p+-- > |- b+-- > |- a <--+treeCursorSwapNext :: TreeCursor a b -> SwapResult (TreeCursor a b)+treeCursorSwapNext tc =+ case treeAbove tc of+ Nothing -> SwapperIsTopNode+ Just ta ->+ case treeAboveRights ta of+ [] -> NoSiblingsToSwapWith+ (t:ts) ->+ Swapped $+ tc+ { treeAbove =+ Just+ ta+ { treeAboveLefts = t : treeAboveLefts ta+ , treeAboveRights = ts+ }+ }++data SwapResult a+ = SwapperIsTopNode+ | NoSiblingsToSwapWith+ | Swapped a+ deriving (Show, Eq, Generic, Functor)++instance Validity a => Validity (SwapResult a)
+ src/Cursor/Tree/Types.hs view
@@ -0,0 +1,157 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor #-}++module Cursor.Tree.Types+ ( TreeCursor(..)+ , treeCursorAboveL+ , treeCursorCurrentL+ , treeCursorBelowL+ , treeCursorCurrentSubTreeL+ , TreeAbove(..)+ , treeAboveLeftsL+ , treeAboveAboveL+ , treeAboveNodeL+ , treeAboveRightsL+ , TreeCursorSelection(..)+ -- * CTree+ , CTree(..)+ , makeCTree+ , cTree+ , rebuildCTree+ , CForest(..)+ , makeCForest+ , cForest+ , rebuildCForest+ , emptyCForest+ , openForest+ , closedForest+ , lengthCForest+ , unpackCForest+ ) where++import Data.List.NonEmpty (NonEmpty(..))+import qualified Data.List.NonEmpty as NE+import Data.Tree+import Data.Validity+import Data.Validity.Tree ()++import GHC.Generics (Generic)++import Lens.Micro++data TreeCursor a b = TreeCursor+ { treeAbove :: !(Maybe (TreeAbove b))+ , treeCurrent :: !a+ , treeBelow :: !(CForest b)+ } deriving (Show, Eq, Generic)++treeCursorAboveL :: Lens' (TreeCursor a b) (Maybe (TreeAbove b))+treeCursorAboveL = lens treeAbove $ \tc ta -> tc {treeAbove = ta}++treeCursorCurrentL :: Lens' (TreeCursor a b) a+treeCursorCurrentL = lens treeCurrent $ \tc a -> tc {treeCurrent = a}++treeCursorBelowL :: Lens' (TreeCursor a b) (CForest b)+treeCursorBelowL = lens treeBelow $ \tc tb -> tc {treeBelow = tb}++treeCursorCurrentSubTreeL :: Lens' (TreeCursor a b) (a, CForest b)+treeCursorCurrentSubTreeL =+ lens+ (\tc -> (treeCurrent tc, treeBelow tc))+ (\tc (a, cf) -> tc {treeCurrent = a, treeBelow = cf})++instance (Validity a, Validity b) => Validity (TreeCursor a b)++data TreeAbove b = TreeAbove+ { treeAboveLefts :: ![CTree b] -- In reverse order+ , treeAboveAbove :: !(Maybe (TreeAbove b))+ , treeAboveNode :: !b+ , treeAboveRights :: ![CTree b]+ } deriving (Show, Eq, Generic, Functor)++instance Validity b => Validity (TreeAbove b)++treeAboveLeftsL :: Lens' (TreeAbove b) [CTree b]+treeAboveLeftsL = lens treeAboveLefts $ \ta tal -> ta {treeAboveLefts = tal}++treeAboveAboveL :: Lens' (TreeAbove b) (Maybe (TreeAbove b))+treeAboveAboveL = lens treeAboveAbove $ \ta taa -> ta {treeAboveAbove = taa}++treeAboveNodeL :: Lens' (TreeAbove b) b+treeAboveNodeL = lens treeAboveNode $ \ta a -> ta {treeAboveNode = a}++treeAboveRightsL :: Lens' (TreeAbove b) [CTree b]+treeAboveRightsL = lens treeAboveRights $ \ta tar -> ta {treeAboveRights = tar}++data TreeCursorSelection+ = SelectNode+ | SelectChild !Int+ !TreeCursorSelection+ deriving (Show, Eq, Generic)++instance Validity TreeCursorSelection++data CTree a =+ CNode !a+ !(CForest a)+ deriving (Show, Eq, Generic, Functor)++instance Validity a => Validity (CTree a)++makeCTree :: Tree a -> CTree a+makeCTree = cTree False++cTree :: Bool -> Tree a -> CTree a+cTree b (Node v f) = CNode v $ cForest b f++rebuildCTree :: CTree a -> Tree a+rebuildCTree (CNode v cf) = Node v $ rebuildCForest cf++data CForest a+ = EmptyCForest+ | ClosedForest !(NonEmpty (Tree a))+ | OpenForest !(NonEmpty (CTree a))+ deriving (Show, Eq, Generic, Functor)++instance Validity a => Validity (CForest a)++makeCForest :: Forest a -> CForest a+makeCForest = cForest True++cForest :: Bool -> Forest a -> CForest a+cForest b f =+ if b+ then openForest $ map (cTree b) f+ else closedForest f++rebuildCForest :: CForest a -> Forest a+rebuildCForest EmptyCForest = []+rebuildCForest (ClosedForest f) = NE.toList f+rebuildCForest (OpenForest ct) = NE.toList $ NE.map rebuildCTree ct++emptyCForest :: CForest a+emptyCForest = EmptyCForest++openForest :: [CTree a] -> CForest a+openForest ts =+ case NE.nonEmpty ts of+ Nothing -> emptyCForest+ Just ne -> OpenForest ne++closedForest :: [Tree a] -> CForest a+closedForest ts =+ case NE.nonEmpty ts of+ Nothing -> emptyCForest+ Just ne -> ClosedForest ne++lengthCForest :: CForest a -> Int+lengthCForest EmptyCForest = 0+lengthCForest (ClosedForest ts) = length ts+lengthCForest (OpenForest ts) = length ts++unpackCForest :: CForest a -> [CTree a]+unpackCForest EmptyCForest = []+unpackCForest (ClosedForest ts) = NE.toList $ NE.map makeCTree ts+unpackCForest (OpenForest ts) = NE.toList ts
+ src/Cursor/Types.hs view
@@ -0,0 +1,69 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE RankNTypes #-}++module Cursor.Types where++import GHC.Generics (Generic)++import Data.Validity++import Data.Functor.Compose++import Control.Applicative++import Lens.Micro++data DeleteOrUpdate a+ = Deleted+ | Updated a+ deriving (Show, Eq, Generic)++instance Validity a => Validity (DeleteOrUpdate a)++instance Functor DeleteOrUpdate where+ fmap _ Deleted = Deleted+ fmap f (Updated a) = Updated (f a)++instance Applicative DeleteOrUpdate where+ pure = Updated+ Deleted <*> _ = Deleted+ _ <*> Deleted = Deleted+ (Updated f) <*> (Updated a) = Updated (f a)++instance Alternative DeleteOrUpdate where+ empty = Deleted+ Updated a <|> _ = Updated a+ Deleted <|> doua = doua++joinDeletes ::+ Maybe (DeleteOrUpdate a) -> Maybe (DeleteOrUpdate a) -> DeleteOrUpdate a+joinDeletes m1 m2 =+ case (m1, m2) of+ (Nothing, Nothing) -> Deleted+ (Nothing, Just a) -> a+ (Just a, _) -> a++joinDeletes3 ::+ Maybe (DeleteOrUpdate a)+ -> Maybe (DeleteOrUpdate a)+ -> Maybe (DeleteOrUpdate a)+ -> DeleteOrUpdate a+joinDeletes3 m1 m2 m3 =+ case (m1, m2, m3) of+ (Nothing, Nothing, Nothing) -> Deleted+ (Nothing, Nothing, Just a) -> a+ (Nothing, Just a, _) -> a+ (Just a, _, _) -> a++joinPossibleDeletes ::+ Maybe (DeleteOrUpdate a)+ -> Maybe (DeleteOrUpdate a)+ -> Maybe (DeleteOrUpdate a)+joinPossibleDeletes d1 d2 = getCompose $ Compose d1 <|> Compose d2++focusPossibleDeleteOrUpdate ::+ Lens' b a+ -> (a -> Maybe (DeleteOrUpdate a))+ -> b+ -> Maybe (DeleteOrUpdate b)+focusPossibleDeleteOrUpdate l func = getCompose . l (Compose . func)