diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,12 @@ ## [Unreleased] +## [0.3.0.0] - 2020-02-14 + +### Changed + +- NFData instances for benchmarks + ## [0.2.0.0] - 2019-09-23 ### Changed diff --git a/cursor.cabal b/cursor.cabal --- a/cursor.cabal +++ b/cursor.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 198732d25b67091588b88dbc6fd99fc8847ea61c7ebadc1ce7a7f313a60a70eb +-- hash: eb21207b1fb477978ab67b054e6cadf6a1d4b7ccfc60a7dea2f0e206586eb33f name: cursor -version: 0.2.0.0 +version: 0.3.0.0 synopsis: Purely Functional Cursors description: Purely Functional Cursors for common data structures . @@ -57,6 +57,7 @@ build-depends: base <5 , containers + , deepseq , microlens , text , validity >=0.8.0.0 diff --git a/src/Cursor/Forest.hs b/src/Cursor/Forest.hs --- a/src/Cursor/Forest.hs +++ b/src/Cursor/Forest.hs @@ -1,7 +1,6 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Forest ( ForestCursor(..) @@ -89,6 +88,7 @@ import Data.Tree import Control.Applicative +import Control.DeepSeq import Lens.Micro @@ -104,28 +104,27 @@ instance (Validity a, Validity b) => Validity (ForestCursor a b) +instance (NFData a, NFData b) => NFData (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 +rebuildForestCursor f = rebuildNonEmptyCursor (rebuildTreeCursor f) . forestCursorListCursor drawForestCursor :: (Show a, Show b) => ForestCursor a b -> String drawForestCursor ForestCursor {..} = drawForest $ - (map showCTree $ reverse $ nonEmptyCursorPrev forestCursorListCursor) ++ + map showCTree (reverse $ nonEmptyCursorPrev forestCursorListCursor) ++ [treeCursorWithPointer $ nonEmptyCursorCurrent forestCursorListCursor] ++ - (map showCTree $ nonEmptyCursorNext 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) +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} +forestCursorListCursorL = lens forestCursorListCursor $ \fc lc -> fc {forestCursorListCursor = lc} forestCursorSelectedTreeL :: Lens' (ForestCursor a b) (TreeCursor a b) forestCursorSelectedTreeL = forestCursorListCursorL . nonEmptyCursorElemL @@ -133,40 +132,32 @@ forestCursorSelectPrevTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) forestCursorSelectPrevTreeCursor f g = - forestCursorListCursorL $ - nonEmptyCursorSelectPrev (rebuildTreeCursor f) (makeTreeCursor 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) + forestCursorListCursorL $ nonEmptyCursorSelectNext (rebuildTreeCursor f) (makeTreeCursor g) -forestCursorSelectFirstTreeCursor :: - (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b +forestCursorSelectFirstTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectFirstTreeCursor f g = - forestCursorListCursorL %~ - (nonEmptyCursorSelectFirst (rebuildTreeCursor f) (makeTreeCursor g)) + forestCursorListCursorL %~ nonEmptyCursorSelectFirst (rebuildTreeCursor f) (makeTreeCursor g) -forestCursorSelectLastTreeCursor :: - (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b +forestCursorSelectLastTreeCursor :: (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b forestCursorSelectLastTreeCursor f g = - forestCursorListCursorL %~ - (nonEmptyCursorSelectLast (rebuildTreeCursor f) (makeTreeCursor g)) + forestCursorListCursorL %~ nonEmptyCursorSelectLast (rebuildTreeCursor f) (makeTreeCursor g) -forestCursorSelectNext :: - (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) +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 :: (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) + forestCursorSelectPrevTreeCursor f g fc forestCursorSelectNextOnSameLevel :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) @@ -180,8 +171,7 @@ (fc & forestCursorSelectedTreeL (treeCursorSelectPrevOnSameLevel f g)) <|> forestCursorSelectPrevTreeCursor f g fc -forestCursorSelectFirst :: - (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b +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' @@ -190,8 +180,7 @@ Just fc' -> forestCursorSelectFirst f g fc' Nothing -> fc -forestCursorSelectLast :: - (a -> b) -> (b -> a) -> ForestCursor a b -> ForestCursor a b +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' @@ -200,77 +189,60 @@ Just fc' -> forestCursorSelectLast f g fc' Nothing -> fc -forestCursorSelectAbove :: - (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) -forestCursorSelectAbove f g = - forestCursorSelectedTreeL $ treeCursorSelectAbove f g +forestCursorSelectAbove :: (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) +forestCursorSelectAbove f g = forestCursorSelectedTreeL $ treeCursorSelectAbove f g forestCursorSelectBelowAtPos :: (a -> b) -> (b -> a) -> Int -> ForestCursor a b -> Maybe (ForestCursor a b) -forestCursorSelectBelowAtPos f g i = - forestCursorSelectedTreeL $ treeCursorSelectBelowAtPos f g i +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 +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 +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 +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) + forestCursorListCursorL (nonEmptyCursorSelectIndex (rebuildTreeCursor f) (makeTreeCursor g) i) forestCursorOpenCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) -forestCursorOpenCurrentForest = - forestCursorSelectedTreeL treeCursorOpenCurrentForest +forestCursorOpenCurrentForest = forestCursorSelectedTreeL treeCursorOpenCurrentForest forestCursorCloseCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) -forestCursorCloseCurrentForest = - forestCursorSelectedTreeL treeCursorCloseCurrentForest +forestCursorCloseCurrentForest = forestCursorSelectedTreeL treeCursorCloseCurrentForest forestCursorToggleCurrentForest :: ForestCursor a b -> Maybe (ForestCursor a b) -forestCursorToggleCurrentForest = - forestCursorSelectedTreeL treeCursorToggleCurrentForest +forestCursorToggleCurrentForest = forestCursorSelectedTreeL treeCursorToggleCurrentForest -forestCursorOpenCurrentForestRecursively :: - ForestCursor a b -> Maybe (ForestCursor a b) +forestCursorOpenCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b) forestCursorOpenCurrentForestRecursively = forestCursorSelectedTreeL treeCursorOpenCurrentForestRecursively -forestCursorToggleCurrentForestRecursively :: - ForestCursor a b -> Maybe (ForestCursor a b) +forestCursorToggleCurrentForestRecursively :: ForestCursor a b -> Maybe (ForestCursor a b) forestCursorToggleCurrentForestRecursively = forestCursorSelectedTreeL treeCursorToggleCurrentForestRecursively forestCursorInsertEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b -forestCursorInsertEntireTree t = - forestCursorListCursorL %~ nonEmptyCursorInsert (makeCTree t) +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 + forestCursorListCursorL %~ nonEmptyCursorInsertAndSelect (rebuildTreeCursor f) tc forestCursorAppendEntireTree :: Tree b -> ForestCursor a b -> ForestCursor a b -forestCursorAppendEntireTree t = - forestCursorListCursorL %~ nonEmptyCursorAppend (makeCTree t) +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 + forestCursorListCursorL %~ nonEmptyCursorAppendAndSelect (rebuildTreeCursor f) tc forestCursorInsertTree :: Tree b -> ForestCursor a b -> ForestCursor a b forestCursorInsertTree t fc = @@ -280,8 +252,7 @@ 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) $ + fromMaybe (forestCursorInsertAndSelectTreeCursor f (makeTreeCursor g $ makeCTree t) fc) $ fc & forestCursorSelectedTreeL (treeCursorInsertAndSelect f g t) forestCursorAppendTree :: Tree b -> ForestCursor a b -> ForestCursor a b @@ -292,90 +263,72 @@ 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) $ + 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 [] +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 [] +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 +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 +forestCursorAddChildTreeToNodeAtStart :: Tree b -> ForestCursor a b -> ForestCursor a b +forestCursorAddChildTreeToNodeAtStart t = forestCursorSelectedTreeL %~ treeCursorAddChildAtStart t -forestCursorAddChildTreeToNodeAtEnd :: - Tree b -> ForestCursor a b -> ForestCursor a b +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 [] +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 [] +forestCursorAddChildToNodeAtStart b = forestCursorAddChildTreeToNodeAtStart $ Node b [] forestCursorAddChildToNodeAtEnd :: b -> ForestCursor a b -> ForestCursor a b -forestCursorAddChildToNodeAtEnd b = - forestCursorAddChildTreeToNodeAtEnd $ Node 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 & + case fc & focusPossibleDeleteOrUpdate - forestCursorListCursorL - (nonEmptyCursorRemoveElemAndSelectPrev (makeTreeCursor g))) + 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 + case fc & + focusPossibleDeleteOrUpdate forestCursorSelectedTreeL (treeCursorDeleteElemAndSelectNext g) of Just Deleted -> - (fc & - focusPossibleDeleteOrUpdate - forestCursorListCursorL - (nonEmptyCursorDeleteElemAndSelectNext (makeTreeCursor g))) + fc & + focusPossibleDeleteOrUpdate + forestCursorListCursorL + (nonEmptyCursorDeleteElemAndSelectNext (makeTreeCursor g)) r -> r -forestCursorRemoveElem :: - (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) +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 :: (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) forestCursorDeleteElem g fc = (fc & forestCursorSelectedTreeL (treeCursorDeleteElem g)) <|> (fc & forestCursorListCursorL (nonEmptyCursorDeleteElem (makeTreeCursor g))) @@ -398,28 +351,23 @@ forestCursorDeleteSubTreeAndSelectNext g fc = joinPossibleDeletes (fc & - focusPossibleDeleteOrUpdate - forestCursorSelectedTreeL - (treeCursorDeleteSubTreeAndSelectNext g)) + focusPossibleDeleteOrUpdate forestCursorSelectedTreeL (treeCursorDeleteSubTreeAndSelectNext g)) (fc & focusPossibleDeleteOrUpdate forestCursorListCursorL (nonEmptyCursorDeleteElemAndSelectNext (makeTreeCursor g))) -forestCursorRemoveSubTree :: - (b -> a) -> ForestCursor a b -> DeleteOrUpdate (ForestCursor a b) +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 :: (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 :: (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 @@ -446,11 +394,7 @@ [] -> Nothing (t:ts) -> pure $ - ForestCursor - ne - { nonEmptyCursorPrev = ts - , nonEmptyCursorNext = t : nonEmptyCursorNext ne - } + ForestCursor ne {nonEmptyCursorPrev = ts, nonEmptyCursorNext = t : nonEmptyCursorNext ne} -- | Swaps the current node with the next node on the same level -- @@ -475,11 +419,7 @@ [] -> Nothing (t:ts) -> pure $ - ForestCursor - ne - { nonEmptyCursorPrev = t : nonEmptyCursorPrev ne - , nonEmptyCursorNext = ts - } + ForestCursor ne {nonEmptyCursorPrev = t : nonEmptyCursorPrev ne, nonEmptyCursorNext = ts} -- | Promotes the current node to the level of its parent. -- @@ -506,8 +446,7 @@ -- > |- g -- > - d <-- -- > - h -forestCursorPromoteElem :: - (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) +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' @@ -517,17 +456,13 @@ let tc = fc ^. forestCursorSelectedTreeL ta <- treeAbove tc lefts <- - case (treeBelow tc) of + 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 + pure $ CNode t (openForest $ unpackCForest ls ++ unpackCForest (treeBelow tc)) : ts let ta' = ta {treeAboveLefts = lefts} let tc' = tc {treeAbove = Just ta'} tc'' <- @@ -537,11 +472,9 @@ pure $ ForestCursor $ ne - { nonEmptyCursorPrev = - rebuildTreeCursor f tc'' : nonEmptyCursorPrev ne + { nonEmptyCursorPrev = rebuildTreeCursor f tc'' : nonEmptyCursorPrev ne , nonEmptyCursorCurrent = - singletonTreeCursor $ - treeCurrent $ fc ^. forestCursorSelectedTreeL + singletonTreeCursor $ treeCurrent $ fc ^. forestCursorSelectedTreeL } -- | Promotes the current node to the level of its parent. @@ -570,8 +503,7 @@ -- > - d <-- -- > |- e -- > - h -forestCursorPromoteSubTree :: - (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) +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' @@ -583,10 +515,8 @@ pure $ ForestCursor $ ne - { nonEmptyCursorPrev = - rebuildTreeCursor f tc' : nonEmptyCursorPrev ne - , nonEmptyCursorCurrent = - (fc ^. forestCursorSelectedTreeL) {treeAbove = Nothing} + { nonEmptyCursorPrev = rebuildTreeCursor f tc' : nonEmptyCursorPrev ne + , nonEmptyCursorCurrent = (fc ^. forestCursorSelectedTreeL) {treeAbove = Nothing} } -- | Demotes the current node to the level of its children. @@ -608,31 +538,20 @@ -- > |- c <-- -- > |- d -- > - e -forestCursorDemoteElem :: - (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) +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 + 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 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} + 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. @@ -652,8 +571,7 @@ -- > |- b -- > |- c <-- -- > |- d -forestCursorDemoteSubTree :: - (a -> b) -> (b -> a) -> ForestCursor a b -> Maybe (ForestCursor a b) +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' @@ -664,17 +582,9 @@ 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} + 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. @@ -714,8 +624,7 @@ , treeCurrent = treeCurrent t , treeBelow = emptyCForest } - , nonEmptyCursorNext = - CNode b2 (treeBelow t) : nonEmptyCursorNext ne + , nonEmptyCursorNext = CNode b2 (treeBelow t) : nonEmptyCursorNext ne } -- | Demotes the current subtree to the level of its children, by adding a root. @@ -733,15 +642,10 @@ -- > |- a <-- -- > |- b forestCursorDemoteSubTreeUnder :: b -> ForestCursor a b -> ForestCursor a b -forestCursorDemoteSubTreeUnder b = - forestCursorSelectedTreeL %~ treeCursorDemoteSubTreeUnder b +forestCursorDemoteSubTreeUnder b = forestCursorSelectedTreeL %~ treeCursorDemoteSubTreeUnder b -traverseForestCursor :: - ([CTree b] -> TreeCursor a b -> [CTree b] -> f c) - -> ForestCursor a b - -> f c +traverseForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> f c) -> ForestCursor a b -> f c traverseForestCursor = foldForestCursor -foldForestCursor :: - ([CTree b] -> TreeCursor a b -> [CTree b] -> c) -> ForestCursor a b -> c +foldForestCursor :: ([CTree b] -> TreeCursor a b -> [CTree b] -> c) -> ForestCursor a b -> c foldForestCursor func (ForestCursor ne) = foldNonEmptyCursor func ne diff --git a/src/Cursor/List.hs b/src/Cursor/List.hs --- a/src/Cursor/List.hs +++ b/src/Cursor/List.hs @@ -33,6 +33,8 @@ import Data.Validity +import Control.DeepSeq + import Cursor.Types data ListCursor a = @@ -44,6 +46,8 @@ instance Validity a => Validity (ListCursor a) +instance NFData a => NFData (ListCursor a) + emptyListCursor :: ListCursor a emptyListCursor = ListCursor {listCursorPrev = [], listCursorNext = []} @@ -54,10 +58,7 @@ makeListCursorWithSelection i as | i < 0 = Nothing | i > length as = Nothing - | otherwise = - Just - ListCursor - {listCursorPrev = reverse $ take i as, listCursorNext = drop i as} + | otherwise = Just ListCursor {listCursorPrev = reverse $ take i as, listCursorNext = drop i as} rebuildListCursor :: ListCursor a -> [a] rebuildListCursor ListCursor {..} = reverse listCursorPrev ++ listCursorNext @@ -75,17 +76,13 @@ listCursorSelectPrev tc = case listCursorPrev tc of [] -> Nothing - (c:cs) -> - Just - ListCursor {listCursorPrev = cs, listCursorNext = c : listCursorNext tc} + (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} + (c:cs) -> Just ListCursor {listCursorPrev = c : listCursorPrev tc, listCursorNext = cs} listCursorSelectIndex :: Int -> ListCursor a -> ListCursor a listCursorSelectIndex ix_ lc = @@ -149,13 +146,10 @@ listCursorCombine :: ListCursor a -> ListCursor a -> ListCursor a listCursorCombine lc1 lc2 = ListCursor - { listCursorPrev = reverse $ rebuildListCursor lc1 - , listCursorNext = rebuildListCursor lc2 - } + {listCursorPrev = reverse $ rebuildListCursor lc1, listCursorNext = rebuildListCursor lc2} traverseListCursor :: ([a] -> [a] -> f b) -> ListCursor a -> f b traverseListCursor = foldListCursor foldListCursor :: ([a] -> [a] -> b) -> ListCursor a -> b -foldListCursor func ListCursor {..} = - func (reverse listCursorPrev) listCursorNext +foldListCursor func ListCursor {..} = func (reverse listCursorPrev) listCursorNext diff --git a/src/Cursor/List/NonEmpty.hs b/src/Cursor/List/NonEmpty.hs --- a/src/Cursor/List/NonEmpty.hs +++ b/src/Cursor/List/NonEmpty.hs @@ -40,10 +40,10 @@ import GHC.Generics (Generic) -import Data.Validity - import Data.Maybe +import Data.Validity +import Control.DeepSeq import Control.Monad import Lens.Micro @@ -64,19 +64,17 @@ instance (Validity a, Validity b) => Validity (NonEmptyCursor a b) +instance (NFData a, NFData b) => NFData (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 :: (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 - } + {nonEmptyCursorPrev = reverse l, nonEmptyCursorCurrent = g m, nonEmptyCursorNext = r} where applyNonEmptySelection :: NonEmpty a -> Int -> Maybe ([a], a, [a]) applyNonEmptySelection (c :| rest) i_ @@ -89,19 +87,13 @@ singletonNonEmptyCursor :: a -> NonEmptyCursor a b singletonNonEmptyCursor a = - NonEmptyCursor - { nonEmptyCursorPrev = [] - , nonEmptyCursorCurrent = a - , nonEmptyCursorNext = [] - } + NonEmptyCursor {nonEmptyCursorPrev = [], nonEmptyCursorCurrent = a, nonEmptyCursorNext = []} rebuildNonEmptyCursor :: (a -> b) -> NonEmptyCursor a b -> NonEmpty b rebuildNonEmptyCursor f NonEmptyCursor {..} = - nonemptyPrepend (reverse nonEmptyCursorPrev) $ - f nonEmptyCursorCurrent :| nonEmptyCursorNext + nonemptyPrepend (reverse nonEmptyCursorPrev) $ f nonEmptyCursorCurrent :| nonEmptyCursorNext -mapNonEmptyCursor :: - (a -> c) -> (b -> d) -> NonEmptyCursor a b -> NonEmptyCursor c d +mapNonEmptyCursor :: (a -> c) -> (b -> d) -> NonEmptyCursor a b -> NonEmptyCursor c d mapNonEmptyCursor f g NonEmptyCursor {..} = NonEmptyCursor { nonEmptyCursorPrev = map g nonEmptyCursorPrev @@ -110,11 +102,9 @@ } nonEmptyCursorElemL :: Lens (NonEmptyCursor a c) (NonEmptyCursor b c) a b -nonEmptyCursorElemL = - lens nonEmptyCursorCurrent $ \lec le -> lec {nonEmptyCursorCurrent = le} +nonEmptyCursorElemL = lens nonEmptyCursorCurrent $ \lec le -> lec {nonEmptyCursorCurrent = le} -nonEmptyCursorSelectPrev :: - (a -> b) -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b) +nonEmptyCursorSelectPrev :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b) nonEmptyCursorSelectPrev f g lec = case nonEmptyCursorPrev lec of [] -> Nothing @@ -123,33 +113,28 @@ lec { nonEmptyCursorPrev = rest , nonEmptyCursorCurrent = g e - , nonEmptyCursorNext = - f (nonEmptyCursorCurrent lec) : nonEmptyCursorNext lec + , nonEmptyCursorNext = f (nonEmptyCursorCurrent lec) : nonEmptyCursorNext lec } -nonEmptyCursorSelectNext :: - (a -> b) -> (b -> a) -> NonEmptyCursor a b -> Maybe (NonEmptyCursor a b) +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 + { nonEmptyCursorPrev = f (nonEmptyCursorCurrent lec) : nonEmptyCursorPrev lec , nonEmptyCursorCurrent = g e , nonEmptyCursorNext = rest } -nonEmptyCursorSelectFirst :: - (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b +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 :: (a -> b) -> (b -> a) -> NonEmptyCursor a b -> NonEmptyCursor a b nonEmptyCursorSelectLast f g lec = case nonEmptyCursorSelectNext f g lec of Nothing -> lec @@ -159,11 +144,7 @@ nonEmptyCursorSelection = length . nonEmptyCursorPrev nonEmptyCursorSelectIndex :: - (a -> b) - -> (b -> a) - -> Int - -> NonEmptyCursor a b - -> Maybe (NonEmptyCursor a b) + (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 @@ -172,38 +153,30 @@ | otherwise = Just nec nonEmptyCursorInsert :: b -> NonEmptyCursor a b -> NonEmptyCursor a b -nonEmptyCursorInsert c lec = - lec {nonEmptyCursorPrev = c : nonEmptyCursorPrev lec} +nonEmptyCursorInsert c lec = lec {nonEmptyCursorPrev = c : nonEmptyCursorPrev lec} nonEmptyCursorAppend :: b -> NonEmptyCursor a b -> NonEmptyCursor a b -nonEmptyCursorAppend c lec = - lec {nonEmptyCursorNext = c : nonEmptyCursorNext lec} +nonEmptyCursorAppend c lec = lec {nonEmptyCursorNext = c : nonEmptyCursorNext lec} -nonEmptyCursorInsertAndSelect :: - (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b +nonEmptyCursorInsertAndSelect :: (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b nonEmptyCursorInsertAndSelect f c lec = lec { nonEmptyCursorCurrent = c - , nonEmptyCursorNext = - f (nonEmptyCursorCurrent lec) : nonEmptyCursorNext lec + , nonEmptyCursorNext = f (nonEmptyCursorCurrent lec) : nonEmptyCursorNext lec } -nonEmptyCursorAppendAndSelect :: - (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b +nonEmptyCursorAppendAndSelect :: (a -> b) -> a -> NonEmptyCursor a b -> NonEmptyCursor a b nonEmptyCursorAppendAndSelect f c lec = lec { nonEmptyCursorCurrent = c - , nonEmptyCursorPrev = - f (nonEmptyCursorCurrent lec) : nonEmptyCursorPrev lec + , nonEmptyCursorPrev = f (nonEmptyCursorCurrent lec) : nonEmptyCursorPrev lec } nonEmptyCursorInsertAtStart :: b -> NonEmptyCursor a b -> NonEmptyCursor a b -nonEmptyCursorInsertAtStart c lec = - lec {nonEmptyCursorPrev = nonEmptyCursorPrev lec ++ [c]} +nonEmptyCursorInsertAtStart c lec = lec {nonEmptyCursorPrev = nonEmptyCursorPrev lec ++ [c]} nonEmptyCursorAppendAtEnd :: b -> NonEmptyCursor a b -> NonEmptyCursor a b -nonEmptyCursorAppendAtEnd c lec = - lec {nonEmptyCursorNext = nonEmptyCursorNext lec ++ [c]} +nonEmptyCursorAppendAtEnd c lec = lec {nonEmptyCursorNext = nonEmptyCursorNext lec ++ [c]} nonEmptyCursorInsertAtStartAndSelect :: (a -> b) -> (b -> a) -> b -> NonEmptyCursor a b -> NonEmptyCursor a b @@ -216,53 +189,39 @@ nonEmptyCursorSelectLast f g . nonEmptyCursorAppendAtEnd c nonEmptyCursorRemoveElemAndSelectPrev :: - (b -> a) - -> NonEmptyCursor a b - -> Maybe (DeleteOrUpdate (NonEmptyCursor a b)) + (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} + (e:rest) -> Just $ Updated $ lec {nonEmptyCursorPrev = rest, nonEmptyCursorCurrent = g e} nonEmptyCursorDeleteElemAndSelectNext :: - (b -> a) - -> NonEmptyCursor a b - -> Maybe (DeleteOrUpdate (NonEmptyCursor a b)) + (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} + (e:rest) -> Just $ Updated $ lec {nonEmptyCursorCurrent = g e, nonEmptyCursorNext = rest} -nonEmptyCursorRemoveElem :: - (b -> a) -> NonEmptyCursor a b -> DeleteOrUpdate (NonEmptyCursor a b) +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 :: (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) + (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 @@ -277,12 +236,7 @@ else look func nec' nonEmptyCursorSelectOrAdd :: - (a -> b) - -> (b -> a) - -> (a -> Bool) - -> a - -> NonEmptyCursor a b - -> NonEmptyCursor a b + (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 diff --git a/src/Cursor/Map.hs b/src/Cursor/Map.hs --- a/src/Cursor/Map.hs +++ b/src/Cursor/Map.hs @@ -1,7 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} module Cursor.Map @@ -48,6 +46,8 @@ import Data.List.NonEmpty (NonEmpty(..)) import Data.Maybe +import Control.DeepSeq + import Lens.Micro import Cursor.List.NonEmpty @@ -60,110 +60,72 @@ } deriving (Show, Eq, Generic) -instance (Validity kc, Validity vc, Validity k, Validity v) => - Validity (MapCursor kc vc k v) +instance (Validity kc, Validity vc, Validity k, Validity v) => Validity (MapCursor kc vc k v) +instance (NFData kc, NFData vc, NFData k, NFData v) => NFData (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 :: (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 + 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} + MapCursor {mapCursorList = singletonNonEmptyCursor $ makeKeyValueCursorKey kc v} singletonMapCursorValue :: k -> vc -> MapCursor kc vc k v singletonMapCursorValue k vc = - MapCursor - {mapCursorList = singletonNonEmptyCursor $ makeKeyValueCursorValue 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 +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 + (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 %~ 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} +mapCursorNonEmptyCursorL = lens mapCursorList $ \mc ne -> mc {mapCursorList = ne} -mapCursorElemL :: Lens' (MapCursor kc vc k v) (KeyValueCursor kc vc k v) +mapCursorElemL :: + Lens (MapCursor kc vc k v) (MapCursor kc' vc' k v) (KeyValueCursor 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 :: (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 :: (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 + (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) + (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) + (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 + (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)) + mapCursorNonEmptyCursorL %~ nonEmptyCursorSelectFirst (rebuild f h) (make g) mapCursorSelectLast :: - (kc -> k) - -> (k -> kc) - -> (vc -> v) - -> MapCursor kc vc k v - -> MapCursor kc vc k v + (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)) + mapCursorNonEmptyCursorL %~ nonEmptyCursorSelectLast (rebuild f h) (make g) mapCursorSelection :: MapCursor kc vc k v -> Int mapCursorSelection = nonEmptyCursorSelection . mapCursorList @@ -179,80 +141,52 @@ 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)) +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)) +mapCursorAppend k v = mapCursorNonEmptyCursorL %~ nonEmptyCursorAppend (k, v) mapCursorInsertAndSelectKey :: - (kc -> k) - -> (vc -> v) - -> kc - -> v - -> MapCursor kc vc k v - -> MapCursor kc vc k v + (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)) + nonEmptyCursorInsertAndSelect (rebuild f h) (makeKeyValueCursorKey kc v) mapCursorAppendAndSelectKey :: - (kc -> k) - -> (vc -> v) - -> kc - -> v - -> MapCursor kc vc k v - -> MapCursor kc vc k v + (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)) + nonEmptyCursorAppendAndSelect (rebuild f h) (makeKeyValueCursorKey kc v) mapCursorInsertAndSelectValue :: - (kc -> k) - -> (vc -> v) - -> k - -> vc - -> MapCursor kc vc k v - -> MapCursor kc vc k v + (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)) + nonEmptyCursorInsertAndSelect (rebuild f h) (makeKeyValueCursorValue k vc) mapCursorAppendAndSelectValue :: - (kc -> k) - -> (vc -> v) - -> k - -> vc - -> MapCursor kc vc k v - -> MapCursor kc vc k v + (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)) + nonEmptyCursorAppendAndSelect (rebuild f h) (makeKeyValueCursorValue k vc) mapCursorRemoveElemAndSelectPrev :: - (k -> kc) - -> MapCursor kc vc k v - -> Maybe (DeleteOrUpdate (MapCursor kc vc k v)) + (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)) + (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) +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) +mapCursorDeleteElem :: (k -> kc) -> MapCursor kc vc k v -> DeleteOrUpdate (MapCursor kc vc k v) +mapCursorDeleteElem g = mapCursorNonEmptyCursorL $ nonEmptyCursorDeleteElem (make g) mapCursorSearch :: (kc -> k) @@ -262,8 +196,7 @@ -> 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) + mapCursorNonEmptyCursorL $ nonEmptyCursorSearch (rebuild f h) (make g) (uncurry p . rebuild f h) mapCursorSelectOrAdd :: (kc -> k) @@ -278,19 +211,14 @@ 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 +rebuild = rebuildKeyValueCursor make :: (k -> kc) -> (k, v) -> KeyValueCursor kc vc k v make g (k, v) = makeKeyValueCursorKey (g k) v traverseMapCursor :: - ([(k, v)] -> KeyValueCursor kc vc k v -> [(k, v)] -> f c) - -> MapCursor kc vc k v - -> f c + ([(k, v)] -> KeyValueCursor kc vc k v -> [(k, v)] -> f c) -> MapCursor kc vc k v -> f c traverseMapCursor combFunc = foldNonEmptyCursor combFunc . mapCursorList -foldMapCursor :: - ([(k, v)] -> KeyValueCursor kc vc k v -> [(k, v)] -> c) - -> MapCursor kc vc k v - -> c +foldMapCursor :: ([(k, v)] -> KeyValueCursor kc vc k v -> [(k, v)] -> c) -> MapCursor kc vc k v -> c foldMapCursor combFunc = foldNonEmptyCursor combFunc . mapCursorList diff --git a/src/Cursor/Map/KeyValue.hs b/src/Cursor/Map/KeyValue.hs --- a/src/Cursor/Map/KeyValue.hs +++ b/src/Cursor/Map/KeyValue.hs @@ -1,7 +1,5 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} module Cursor.Map.KeyValue @@ -23,6 +21,8 @@ import Data.Validity +import Control.DeepSeq + data KeyValueCursor kc vc k v = KeyValueCursorKey kc v | KeyValueCursorValue k vc @@ -31,14 +31,15 @@ instance (Validity kc, Validity vc, Validity k, Validity v) => Validity (KeyValueCursor kc vc k v) +instance (NFData kc, NFData vc, NFData k, NFData v) => NFData (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 :: (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) @@ -59,20 +60,14 @@ KeyValueCursorValue k vc -> KeyValueCursorValue (c k) (b vc) keyValueCursorSelectKey :: - (k -> kc) - -> (vc -> v) - -> KeyValueCursor kc vc k v - -> KeyValueCursor kc vc k v + (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 + (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) @@ -97,12 +92,10 @@ instance Validity KeyValueToggle -traverseKeyValueCursor :: - (kc -> v -> f c) -> (k -> vc -> f c) -> KeyValueCursor kc vc k v -> f c +traverseKeyValueCursor :: (kc -> v -> f c) -> (k -> vc -> f c) -> KeyValueCursor kc vc k v -> f c traverseKeyValueCursor = foldKeyValueCursor -foldKeyValueCursor :: - (kc -> v -> c) -> (k -> vc -> c) -> KeyValueCursor kc vc k v -> c +foldKeyValueCursor :: (kc -> v -> c) -> (k -> vc -> c) -> KeyValueCursor kc vc k v -> c foldKeyValueCursor keyFunc valFunc kvc = case kvc of KeyValueCursorKey kc v -> keyFunc kc v diff --git a/src/Cursor/Simple/Forest.hs b/src/Cursor/Simple/Forest.hs --- a/src/Cursor/Simple/Forest.hs +++ b/src/Cursor/Simple/Forest.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Simple.Forest ( ForestCursor @@ -142,15 +139,11 @@ forestCursorSelectIndex :: Int -> ForestCursor a -> Maybe (ForestCursor a) forestCursorSelectIndex = FC.forestCursorSelectIndex id id -forestCursorInsertAndSelectTreeCursor :: - TreeCursor a -> ForestCursor a -> ForestCursor a -forestCursorInsertAndSelectTreeCursor = - FC.forestCursorInsertAndSelectTreeCursor id +forestCursorInsertAndSelectTreeCursor :: TreeCursor a -> ForestCursor a -> ForestCursor a +forestCursorInsertAndSelectTreeCursor = FC.forestCursorInsertAndSelectTreeCursor id -forestCursorAppendAndSelectTreeCursor :: - TreeCursor a -> ForestCursor a -> ForestCursor a -forestCursorAppendAndSelectTreeCursor = - FC.forestCursorAppendAndSelectTreeCursor id +forestCursorAppendAndSelectTreeCursor :: TreeCursor a -> ForestCursor a -> ForestCursor a +forestCursorAppendAndSelectTreeCursor = FC.forestCursorAppendAndSelectTreeCursor id forestCursorInsertAndSelectTree :: Tree a -> ForestCursor a -> ForestCursor a forestCursorInsertAndSelectTree = FC.forestCursorInsertAndSelectTree id id @@ -164,12 +157,10 @@ forestCursorAppendAndSelect :: a -> ForestCursor a -> ForestCursor a forestCursorAppendAndSelect = FC.forestCursorAppendAndSelect id id -forestCursorRemoveElemAndSelectPrev :: - ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) +forestCursorRemoveElemAndSelectPrev :: ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) forestCursorRemoveElemAndSelectPrev = FC.forestCursorRemoveElemAndSelectPrev id -forestCursorDeleteElemAndSelectNext :: - ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) +forestCursorDeleteElemAndSelectNext :: ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) forestCursorDeleteElemAndSelectNext = FC.forestCursorDeleteElemAndSelectNext id forestCursorRemoveElem :: ForestCursor a -> DeleteOrUpdate (ForestCursor a) @@ -178,15 +169,11 @@ forestCursorDeleteElem :: ForestCursor a -> DeleteOrUpdate (ForestCursor a) forestCursorDeleteElem = FC.forestCursorDeleteElem id -forestCursorRemoveSubTreeAndSelectPrev :: - ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) -forestCursorRemoveSubTreeAndSelectPrev = - FC.forestCursorRemoveSubTreeAndSelectPrev id +forestCursorRemoveSubTreeAndSelectPrev :: ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) +forestCursorRemoveSubTreeAndSelectPrev = FC.forestCursorRemoveSubTreeAndSelectPrev id -forestCursorDeleteSubTreeAndSelectNext :: - ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) -forestCursorDeleteSubTreeAndSelectNext = - FC.forestCursorDeleteSubTreeAndSelectNext id +forestCursorDeleteSubTreeAndSelectNext :: ForestCursor a -> Maybe (DeleteOrUpdate (ForestCursor a)) +forestCursorDeleteSubTreeAndSelectNext = FC.forestCursorDeleteSubTreeAndSelectNext id forestCursorRemoveSubTree :: ForestCursor a -> DeleteOrUpdate (ForestCursor a) forestCursorRemoveSubTree = FC.forestCursorRemoveSubTree id diff --git a/src/Cursor/Simple/List/NonEmpty.hs b/src/Cursor/Simple/List/NonEmpty.hs --- a/src/Cursor/Simple/List/NonEmpty.hs +++ b/src/Cursor/Simple/List/NonEmpty.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Simple.List.NonEmpty ( NonEmptyCursor @@ -78,37 +75,28 @@ nonEmptyCursorAppendAndSelect :: a -> NonEmptyCursor a -> NonEmptyCursor a nonEmptyCursorAppendAndSelect = NEC.nonEmptyCursorAppendAndSelect id -nonEmptyCursorInsertAtStartAndSelect :: - a -> NonEmptyCursor a -> NonEmptyCursor a -nonEmptyCursorInsertAtStartAndSelect = - NEC.nonEmptyCursorInsertAtStartAndSelect id id +nonEmptyCursorInsertAtStartAndSelect :: a -> NonEmptyCursor a -> NonEmptyCursor a +nonEmptyCursorInsertAtStartAndSelect = NEC.nonEmptyCursorInsertAtStartAndSelect id id nonEmptyCursorAppendAtEndAndSelect :: a -> NonEmptyCursor a -> NonEmptyCursor a -nonEmptyCursorAppendAtEndAndSelect = - NEC.nonEmptyCursorAppendAtEndAndSelect id id +nonEmptyCursorAppendAtEndAndSelect = NEC.nonEmptyCursorAppendAtEndAndSelect id id nonEmptyCursorRemoveElemAndSelectPrev :: NonEmptyCursor a -> Maybe (DeleteOrUpdate (NonEmptyCursor a)) -nonEmptyCursorRemoveElemAndSelectPrev = - NEC.nonEmptyCursorRemoveElemAndSelectPrev id +nonEmptyCursorRemoveElemAndSelectPrev = NEC.nonEmptyCursorRemoveElemAndSelectPrev id nonEmptyCursorDeleteElemAndSelectNext :: NonEmptyCursor a -> Maybe (DeleteOrUpdate (NonEmptyCursor a)) -nonEmptyCursorDeleteElemAndSelectNext = - NEC.nonEmptyCursorDeleteElemAndSelectNext id +nonEmptyCursorDeleteElemAndSelectNext = NEC.nonEmptyCursorDeleteElemAndSelectNext id -nonEmptyCursorRemoveElem :: - NonEmptyCursor a -> DeleteOrUpdate (NonEmptyCursor a) +nonEmptyCursorRemoveElem :: NonEmptyCursor a -> DeleteOrUpdate (NonEmptyCursor a) nonEmptyCursorRemoveElem = NEC.nonEmptyCursorRemoveElem id -nonEmptyCursorDeleteElem :: - NonEmptyCursor a -> DeleteOrUpdate (NonEmptyCursor a) +nonEmptyCursorDeleteElem :: NonEmptyCursor a -> DeleteOrUpdate (NonEmptyCursor a) nonEmptyCursorDeleteElem = NEC.nonEmptyCursorDeleteElem id -nonEmptyCursorSearch :: - (a -> Bool) -> NonEmptyCursor a -> Maybe (NonEmptyCursor a) +nonEmptyCursorSearch :: (a -> Bool) -> NonEmptyCursor a -> Maybe (NonEmptyCursor a) nonEmptyCursorSearch = NEC.nonEmptyCursorSearch id id -nonEmptyCursorSelectOrAdd :: - (a -> Bool) -> a -> NonEmptyCursor a -> NonEmptyCursor a +nonEmptyCursorSelectOrAdd :: (a -> Bool) -> a -> NonEmptyCursor a -> NonEmptyCursor a nonEmptyCursorSelectOrAdd = NEC.nonEmptyCursorSelectOrAdd id id diff --git a/src/Cursor/Simple/Map.hs b/src/Cursor/Simple/Map.hs --- a/src/Cursor/Simple/Map.hs +++ b/src/Cursor/Simple/Map.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RankNTypes #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE TypeFamilies #-} module Cursor.Simple.Map @@ -95,12 +92,10 @@ mapCursorAppendAndSelectValue :: k -> v -> MapCursor k v -> MapCursor k v mapCursorAppendAndSelectValue = MC.mapCursorAppendAndSelectValue id id -mapCursorRemoveElemAndSelectPrev :: - MapCursor k v -> Maybe (DeleteOrUpdate (MapCursor k v)) +mapCursorRemoveElemAndSelectPrev :: MapCursor k v -> Maybe (DeleteOrUpdate (MapCursor k v)) mapCursorRemoveElemAndSelectPrev = MC.mapCursorRemoveElemAndSelectPrev id -mapCursorDeleteElemAndSelectNext :: - MapCursor k v -> Maybe (DeleteOrUpdate (MapCursor k v)) +mapCursorDeleteElemAndSelectNext :: MapCursor k v -> Maybe (DeleteOrUpdate (MapCursor k v)) mapCursorDeleteElemAndSelectNext = MC.mapCursorDeleteElemAndSelectNext id mapCursorRemoveElem :: MapCursor k v -> DeleteOrUpdate (MapCursor k v) @@ -112,6 +107,5 @@ 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 :: (k -> v -> Bool) -> KeyValueCursor k v -> MapCursor k v -> MapCursor k v mapCursorSelectOrAdd = MC.mapCursorSelectOrAdd id id id diff --git a/src/Cursor/Simple/Map/KeyValue.hs b/src/Cursor/Simple/Map/KeyValue.hs --- a/src/Cursor/Simple/Map/KeyValue.hs +++ b/src/Cursor/Simple/Map/KeyValue.hs @@ -22,8 +22,7 @@ rebuildKeyValueCursor :: KeyValueCursor k v -> (k, v) rebuildKeyValueCursor = KVC.rebuildKeyValueCursor id id -mapKeyValueCursor :: - (k -> l) -> (v -> w) -> KeyValueCursor k v -> KeyValueCursor l w +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 diff --git a/src/Cursor/Simple/Tree.hs b/src/Cursor/Simple/Tree.hs --- a/src/Cursor/Simple/Tree.hs +++ b/src/Cursor/Simple/Tree.hs @@ -1,7 +1,4 @@ -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Simple.Tree ( TreeCursor @@ -90,8 +87,7 @@ makeTreeCursor :: CTree a -> TreeCursor a makeTreeCursor = TC.makeTreeCursor id -makeTreeCursorWithSelection :: - TC.TreeCursorSelection -> CTree a -> Maybe (TreeCursor a) +makeTreeCursorWithSelection :: TC.TreeCursorSelection -> CTree a -> Maybe (TreeCursor a) makeTreeCursorWithSelection = TC.makeTreeCursorWithSelection id id singletonTreeCursor :: a -> TreeCursor a @@ -103,8 +99,7 @@ mapTreeCursor :: (a -> b) -> TreeCursor a -> TreeCursor b mapTreeCursor f = TC.mapTreeCursor f f -treeCursorSelect :: - TC.TreeCursorSelection -> TreeCursor a -> Maybe (TreeCursor a) +treeCursorSelect :: TC.TreeCursorSelection -> TreeCursor a -> Maybe (TreeCursor a) treeCursorSelect = TC.treeCursorSelect id id treeCursorSelectPrev :: TreeCursor a -> Maybe (TreeCursor a) @@ -132,12 +127,10 @@ treeCursorSelectBelowAtEnd = TC.treeCursorSelectBelowAtEnd id id treeCursorSelectBelowAtStartRecursively :: TreeCursor a -> Maybe (TreeCursor a) -treeCursorSelectBelowAtStartRecursively = - TC.treeCursorSelectBelowAtStartRecursively id id +treeCursorSelectBelowAtStartRecursively = TC.treeCursorSelectBelowAtStartRecursively id id treeCursorSelectBelowAtEndRecursively :: TreeCursor a -> Maybe (TreeCursor a) -treeCursorSelectBelowAtEndRecursively = - TC.treeCursorSelectBelowAtEndRecursively id id +treeCursorSelectBelowAtEndRecursively = TC.treeCursorSelectBelowAtEndRecursively id id treeCursorSelectPrevOnSameLevel :: TreeCursor a -> Maybe (TreeCursor a) treeCursorSelectPrevOnSameLevel = TC.treeCursorSelectPrevOnSameLevel id id @@ -161,20 +154,14 @@ treeCursorAppendAndSelect :: Tree a -> TreeCursor a -> Maybe (TreeCursor a) treeCursorAppendAndSelect = TC.treeCursorAppendAndSelect id id -treeCursorDeleteSubTreeAndSelectPrevious :: - TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) -treeCursorDeleteSubTreeAndSelectPrevious = - TC.treeCursorDeleteSubTreeAndSelectPrevious id +treeCursorDeleteSubTreeAndSelectPrevious :: TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) +treeCursorDeleteSubTreeAndSelectPrevious = TC.treeCursorDeleteSubTreeAndSelectPrevious id -treeCursorDeleteSubTreeAndSelectNext :: - TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) -treeCursorDeleteSubTreeAndSelectNext = - TC.treeCursorDeleteSubTreeAndSelectNext id +treeCursorDeleteSubTreeAndSelectNext :: TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) +treeCursorDeleteSubTreeAndSelectNext = TC.treeCursorDeleteSubTreeAndSelectNext id -treeCursorDeleteSubTreeAndSelectAbove :: - TreeCursor a -> DeleteOrUpdate (TreeCursor a) -treeCursorDeleteSubTreeAndSelectAbove = - TC.treeCursorDeleteSubTreeAndSelectAbove id +treeCursorDeleteSubTreeAndSelectAbove :: TreeCursor a -> DeleteOrUpdate (TreeCursor a) +treeCursorDeleteSubTreeAndSelectAbove = TC.treeCursorDeleteSubTreeAndSelectAbove id treeCursorRemoveSubTree :: TreeCursor a -> DeleteOrUpdate (TreeCursor a) treeCursorRemoveSubTree = TC.treeCursorRemoveSubTree id @@ -182,17 +169,13 @@ treeCursorDeleteSubTree :: TreeCursor a -> DeleteOrUpdate (TreeCursor a) treeCursorDeleteSubTree = TC.treeCursorDeleteSubTree id -treeCursorDeleteElemAndSelectPrevious :: - TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) -treeCursorDeleteElemAndSelectPrevious = - TC.treeCursorDeleteElemAndSelectPrevious id +treeCursorDeleteElemAndSelectPrevious :: TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) +treeCursorDeleteElemAndSelectPrevious = TC.treeCursorDeleteElemAndSelectPrevious id -treeCursorDeleteElemAndSelectNext :: - TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) +treeCursorDeleteElemAndSelectNext :: TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) treeCursorDeleteElemAndSelectNext = TC.treeCursorDeleteElemAndSelectNext id -treeCursorDeleteElemAndSelectAbove :: - TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) +treeCursorDeleteElemAndSelectAbove :: TreeCursor a -> Maybe (DeleteOrUpdate (TreeCursor a)) treeCursorDeleteElemAndSelectAbove = TC.treeCursorDeleteElemAndSelectAbove id treeCursorRemoveElem :: TreeCursor a -> DeleteOrUpdate (TreeCursor a) diff --git a/src/Cursor/Text.hs b/src/Cursor/Text.hs --- a/src/Cursor/Text.hs +++ b/src/Cursor/Text.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} module Cursor.Text @@ -32,6 +31,8 @@ import qualified Data.Text as T import Data.Text (Text) +import Control.DeepSeq + import Lens.Micro import Cursor.List @@ -54,6 +55,8 @@ , declare "The character is a safe character" $ isSafeChar c ] ] + +instance NFData TextCursor emptyTextCursor :: TextCursor emptyTextCursor = TextCursor emptyListCursor diff --git a/src/Cursor/TextField.hs b/src/Cursor/TextField.hs --- a/src/Cursor/TextField.hs +++ b/src/Cursor/TextField.hs @@ -43,6 +43,7 @@ import qualified Data.Text as T import Data.Text (Text) +import Control.DeepSeq import Control.Monad import Lens.Micro @@ -66,6 +67,8 @@ declare "The text of this line does not contain any newlines" $ T.all (/= '\n') tc ] +instance NFData TextFieldCursor + makeTextFieldCursor :: Text -> TextFieldCursor makeTextFieldCursor = fromJust . makeTextFieldCursorWithSelection 0 0 @@ -119,7 +122,7 @@ moveMWhileKeepingSelection movement tfc = do let i = textFieldCursorIndexOnLine tfc let tfc' = textFieldCursorSelectIndexOnLine 0 tfc - tfc'' <- textFieldCursorNonEmptyCursorL movement $ tfc' + tfc'' <- textFieldCursorNonEmptyCursorL movement tfc' pure $ textFieldCursorSelectIndexOnLine i tfc'' textFieldCursorSelectFirstLine :: TextFieldCursor -> TextFieldCursor @@ -162,7 +165,7 @@ _ | isSafeChar c -> Just $ - (fromMaybe emptyTextFieldCursor mtfc) & + fromMaybe emptyTextFieldCursor mtfc & textFieldCursorSelectedL %~ (fromJust . textCursorInsert c) | otherwise -> Nothing @@ -176,7 +179,7 @@ _ | isSafeChar c -> Just $ - (fromMaybe emptyTextFieldCursor mtfc) & + fromMaybe emptyTextFieldCursor mtfc & textFieldCursorSelectedL %~ (fromJust . textCursorAppend c) | otherwise -> Nothing diff --git a/src/Cursor/Tree/Base.hs b/src/Cursor/Tree/Base.hs --- a/src/Cursor/Tree/Base.hs +++ b/src/Cursor/Tree/Base.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE DeriveFunctor #-} -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeFamilies #-} @@ -21,19 +19,13 @@ import Cursor.Tree.Types singletonTreeCursor :: a -> TreeCursor a b -singletonTreeCursor v = - TreeCursor {treeAbove = Nothing, treeCurrent = v, treeBelow = emptyCForest} +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} +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) + (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 @@ -53,28 +45,22 @@ } rebuildTreeCursor :: (a -> b) -> TreeCursor a b -> CTree b -rebuildTreeCursor f TreeCursor {..} = - wrapAbove treeAbove $ CNode (f treeCurrent) treeBelow +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] + 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 - } + {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 :: (b -> a) -> CTree b -> Maybe (TreeAbove b) -> TreeCursor a b makeTreeCursorWithAbove g (CNode a forest) mta = TreeCursor {treeAbove = mta, treeCurrent = g a, treeBelow = forest} @@ -92,8 +78,7 @@ wrapAbove (Just ta) = goAbove ta goAbove :: TreeAbove b -> c -> m c goAbove TreeAbove {..} = - wrapFunc (reverse treeAboveLefts) treeAboveNode treeAboveRights >=> - wrapAbove treeAboveAbove + wrapFunc (reverse treeAboveLefts) treeAboveNode treeAboveRights >=> wrapAbove treeAboveAbove foldTreeCursor :: forall a b c. @@ -109,5 +94,4 @@ wrapAbove (Just ta) = goAbove ta goAbove :: TreeAbove b -> c -> c goAbove TreeAbove {..} = - wrapAbove treeAboveAbove . - wrapFunc (reverse treeAboveLefts) treeAboveNode treeAboveRights + wrapAbove treeAboveAbove . wrapFunc (reverse treeAboveLefts) treeAboveNode treeAboveRights diff --git a/src/Cursor/Tree/Collapse.hs b/src/Cursor/Tree/Collapse.hs --- a/src/Cursor/Tree/Collapse.hs +++ b/src/Cursor/Tree/Collapse.hs @@ -22,32 +22,25 @@ case treeBelow tc of EmptyCForest -> Nothing ClosedForest _ -> Nothing - OpenForest ts -> - Just $ tc {treeBelow = ClosedForest $ NE.map rebuildCTree ts} + 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} + OpenForest ts -> Just $ tc {treeBelow = ClosedForest $ NE.map rebuildCTree ts} -treeCursorOpenCurrentForestRecursively :: - TreeCursor a b -> Maybe (TreeCursor a b) +treeCursorOpenCurrentForestRecursively :: TreeCursor a b -> Maybe (TreeCursor a b) treeCursorOpenCurrentForestRecursively tc = case treeBelow tc of EmptyCForest -> Nothing - ClosedForest ts -> - Just $ tc {treeBelow = OpenForest $ NE.map (cTree True) ts} + ClosedForest ts -> Just $ tc {treeBelow = OpenForest $ NE.map (cTree True) ts} OpenForest _ -> Nothing -treeCursorToggleCurrentForestRecursively :: - TreeCursor a b -> Maybe (TreeCursor a b) +treeCursorToggleCurrentForestRecursively :: TreeCursor a b -> Maybe (TreeCursor a b) treeCursorToggleCurrentForestRecursively tc = case treeBelow tc of EmptyCForest -> Nothing - ClosedForest ts -> - Just $ tc {treeBelow = OpenForest $ NE.map (cTree True) ts} - OpenForest ts -> - Just $ tc {treeBelow = ClosedForest $ NE.map rebuildCTree ts} + ClosedForest ts -> Just $ tc {treeBelow = OpenForest $ NE.map (cTree True) ts} + OpenForest ts -> Just $ tc {treeBelow = ClosedForest $ NE.map rebuildCTree ts} diff --git a/src/Cursor/Tree/Delete.hs b/src/Cursor/Tree/Delete.hs --- a/src/Cursor/Tree/Delete.hs +++ b/src/Cursor/Tree/Delete.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Tree.Delete ( treeCursorDeleteSubTreeAndSelectPrevious @@ -34,9 +32,7 @@ Just ta -> case treeAboveLefts ta of [] -> Nothing - tree:xs -> - Just . Updated . makeTreeCursorWithAbove g tree $ - Just ta {treeAboveLefts = xs} + tree:xs -> Just . Updated . makeTreeCursorWithAbove g tree $ Just ta {treeAboveLefts = xs} treeCursorDeleteSubTreeAndSelectNext :: (b -> a) -> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b)) @@ -46,9 +42,7 @@ Just ta -> case treeAboveRights ta of [] -> Nothing - tree:xs -> - Just . Updated . makeTreeCursorWithAbove g tree $ - Just ta {treeAboveRights = xs} + tree:xs -> Just . Updated . makeTreeCursorWithAbove g tree $ Just ta {treeAboveRights = xs} treeCursorDeleteSubTreeAndSelectAbove :: (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b) @@ -63,16 +57,14 @@ , treeBelow = openForest $ reverse treeAboveLefts ++ treeAboveRights } -treeCursorRemoveSubTree :: - (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b) +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 :: (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b) treeCursorDeleteSubTree g tc = joinDeletes (treeCursorDeleteSubTreeAndSelectNext g tc) @@ -94,9 +86,7 @@ Just . Updated . makeTreeCursorWithAbove g tree $ Just ta - { treeAboveLefts = xs - , treeAboveRights = unpackCForest treeBelow ++ treeAboveRights ta - } + {treeAboveLefts = xs, treeAboveRights = unpackCForest treeBelow ++ treeAboveRights ta} treeCursorDeleteElemAndSelectNext :: (b -> a) -> TreeCursor a b -> Maybe (DeleteOrUpdate (TreeCursor a b)) @@ -109,8 +99,7 @@ case treeAboveRights ta of [] -> Nothing tree:xs -> - Just . Updated . makeTreeCursorWithAbove g tree $ - Just ta {treeAboveRights = xs} + Just . Updated . makeTreeCursorWithAbove g tree $ Just ta {treeAboveRights = xs} ClosedForest ts -> case treeAbove of Nothing -> @@ -125,9 +114,7 @@ Just . Updated . makeTreeCursorWithAbove g tree $ Just ta - { treeAboveLefts = - map makeCTree (reverse $ NE.toList ts) ++ - treeAboveLefts ta + { treeAboveLefts = map makeCTree (reverse $ NE.toList ts) ++ treeAboveLefts ta , treeAboveRights = xs } OpenForest (CNode e ts :| xs) -> @@ -136,8 +123,7 @@ case ts of EmptyCForest -> openForest xs OpenForest ts_ -> openForest $ NE.toList ts_ ++ xs - ClosedForest ts_ -> - closedForest $ NE.toList ts_ ++ map rebuildCTree xs + ClosedForest ts_ -> closedForest $ NE.toList ts_ ++ map rebuildCTree xs in Just . Updated $ makeTreeCursorWithAbove g t treeAbove treeCursorDeleteElemAndSelectAbove :: @@ -155,20 +141,17 @@ { treeAbove = treeAboveAbove , treeCurrent = g treeAboveNode , treeBelow = - openForest $ - reverse treeAboveLefts ++ unpackCForest treeBelow ++ treeAboveRights + openForest $ reverse treeAboveLefts ++ unpackCForest treeBelow ++ treeAboveRights } -treeCursorRemoveElem :: - (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b) +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 :: (b -> a) -> TreeCursor a b -> DeleteOrUpdate (TreeCursor a b) treeCursorDeleteElem g tc = joinDeletes3 (treeCursorDeleteElemAndSelectNext g tc) diff --git a/src/Cursor/Tree/Demote.hs b/src/Cursor/Tree/Demote.hs --- a/src/Cursor/Tree/Demote.hs +++ b/src/Cursor/Tree/Demote.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveFunctor #-} @@ -11,9 +10,11 @@ , treeCursorDemoteSubTreeUnder ) where +import GHC.Generics (Generic) + import Data.Validity -import GHC.Generics (Generic) +import Control.DeepSeq import Cursor.Tree.Base import Cursor.Tree.Types @@ -39,8 +40,7 @@ -- > | |- c <-- -- > | |- d -- > |- e -treeCursorDemoteElem :: - (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b) +treeCursorDemoteElem :: (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b) treeCursorDemoteElem f g tc = case treeAbove tc of Nothing -> CannotDemoteTopNode @@ -79,8 +79,7 @@ -- > | |- c <-- -- > | |- d -- > |- e -treeCursorDemoteSubTree :: - (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b) +treeCursorDemoteSubTree :: (a -> b) -> (b -> a) -> TreeCursor a b -> DemoteResult (TreeCursor a b) treeCursorDemoteSubTree f g tc = case treeAbove tc of Nothing -> CannotDemoteTopNode @@ -105,6 +104,8 @@ deriving (Show, Eq, Generic, Functor) instance Validity a => Validity (DemoteResult a) + +instance NFData a => NFData (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. diff --git a/src/Cursor/Tree/Draw.hs b/src/Cursor/Tree/Draw.hs --- a/src/Cursor/Tree/Draw.hs +++ b/src/Cursor/Tree/Draw.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Tree.Draw ( drawTreeCursor @@ -22,24 +20,18 @@ treeCursorWithPointer :: (Show a, Show b) => TreeCursor a b -> Tree String treeCursorWithPointer TreeCursor {..} = - wrapAbove treeAbove $ - Node (show treeCurrent ++ " <---") $ showCForest treeBelow + 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 - ] + 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 (ClosedForest ts) = map (fmap ("hidden: " ++) . showTree) $ NE.toList ts showCForest (OpenForest ts) = map showCTree $ NE.toList ts showCTree :: Show a => CTree a -> Tree String diff --git a/src/Cursor/Tree/Insert.hs b/src/Cursor/Tree/Insert.hs --- a/src/Cursor/Tree/Insert.hs +++ b/src/Cursor/Tree/Insert.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Tree.Insert ( treeCursorInsert @@ -30,8 +28,7 @@ (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} + 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) @@ -70,6 +67,5 @@ treeCursorAddChildAtEnd t tc = case treeBelow tc of EmptyCForest -> tc {treeBelow = openForest [makeCTree t]} - ClosedForest ts -> - tc {treeBelow = openForest $ map makeCTree $ NE.toList ts ++ [t]} + ClosedForest ts -> tc {treeBelow = openForest $ map makeCTree $ NE.toList ts ++ [t]} OpenForest ts -> tc {treeBelow = openForest $ NE.toList ts ++ [makeCTree t]} diff --git a/src/Cursor/Tree/Movement.hs b/src/Cursor/Tree/Movement.hs --- a/src/Cursor/Tree/Movement.hs +++ b/src/Cursor/Tree/Movement.hs @@ -1,7 +1,5 @@ -{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE DeriveFunctor #-} module Cursor.Tree.Movement ( treeCursorSelection @@ -37,47 +35,34 @@ where wrap :: Maybe (TreeAbove a) -> TreeCursorSelection -> TreeCursorSelection wrap Nothing ts = ts - wrap (Just ta) ts = - wrap (treeAboveAbove ta) $ SelectChild (length $ treeAboveLefts ta) 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 + (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 :: (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 :: (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 +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 +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 :: (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 + let newForest = reverse treeAboveLefts ++ [currentTree f tc] ++ treeAboveRights newTree = CNode treeAboveNode $ openForest newForest in Just $ makeTreeCursorWithAbove g newTree treeAboveAbove @@ -101,12 +86,10 @@ , treeAboveRights = rights } -treeCursorSelectBelowAtStart :: - (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b) +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 :: (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b) treeCursorSelectBelowAtEnd f g tc = case treeBelow tc of EmptyCForest -> Nothing @@ -115,57 +98,43 @@ treeCursorSelectBelowAtStartRecursively :: (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b) -treeCursorSelectBelowAtStartRecursively f g tc = - go <$> treeCursorSelectBelowAtStart f g tc +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 +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 :: (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 - } + Just ta {treeAboveLefts = xs, treeAboveRights = currentTree f tc : treeAboveRights ta} -treeCursorSelectNextOnSameLevel :: - (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b) +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 - } + 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 :: (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b) treeCursorSelectAbovePrev f g = - treeCursorSelectPrevOnSameLevel f g >=> - treeCursorSelectBelowAtEndRecursively 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 :: (a -> b) -> (b -> a) -> TreeCursor a b -> Maybe (TreeCursor a b) treeCursorSelectAboveNext f g tc = case treeCursorSelectNextOnSameLevel f g tc of Just _ -> Nothing diff --git a/src/Cursor/Tree/Promote.hs b/src/Cursor/Tree/Promote.hs --- a/src/Cursor/Tree/Promote.hs +++ b/src/Cursor/Tree/Promote.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveFunctor #-} @@ -10,9 +9,11 @@ , PromoteResult(..) ) where +import GHC.Generics (Generic) + import Data.Validity -import GHC.Generics (Generic) +import Control.DeepSeq import Cursor.Tree.Base import Cursor.Tree.Types @@ -45,40 +46,25 @@ -- > |- d <-- -- > |- h treeCursorPromoteElem :: - (a -> b) - -> (b -> a) - -> TreeCursor a b - -> PromoteElemResult (TreeCursor a b) + (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 + ta <- maybe CannotPromoteTopElem pure $ treeAbove tc -- We need to put the below under the above lefts at the end lefts <- - case (treeBelow tc) of + 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 $ CNode t (openForest $ unpackCForest ls ++ unpackCForest (treeBelow tc)) : ts + taa <- maybe NoGrandparentToPromoteElemUnder pure $ treeAboveAbove ta pure $ makeTreeCursorWithAbove g (CNode (f $ treeCurrent tc) emptyCForest) $ Just $ taa { treeAboveLefts = - CNode - (treeAboveNode ta) - (openForest $ reverse lefts ++ treeAboveRights ta) : + CNode (treeAboveNode ta) (openForest $ reverse lefts ++ treeAboveRights ta) : treeAboveLefts taa } @@ -91,6 +77,8 @@ instance Validity a => Validity (PromoteElemResult a) +instance NFData a => NFData (PromoteElemResult a) + instance Applicative PromoteElemResult where pure = PromotedElem CannotPromoteTopElem <*> _ = CannotPromoteTopElem @@ -99,8 +87,7 @@ PromotedElem f <*> PromotedElem a = PromotedElem $ f a PromotedElem _ <*> CannotPromoteTopElem = CannotPromoteTopElem PromotedElem _ <*> NoSiblingsToAdoptChildren = NoSiblingsToAdoptChildren - PromotedElem _ <*> NoGrandparentToPromoteElemUnder = - NoGrandparentToPromoteElemUnder + PromotedElem _ <*> NoGrandparentToPromoteElemUnder = NoGrandparentToPromoteElemUnder instance Monad PromoteElemResult where CannotPromoteTopElem >>= _ = CannotPromoteTopElem @@ -135,25 +122,16 @@ -- > |- d <-- -- > | |- e -- > |- h -treeCursorPromoteSubTree :: - (a -> b) -> (b -> a) -> TreeCursor a b -> PromoteResult (TreeCursor a b) +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 + ta <- maybe CannotPromoteTopNode pure $ treeAbove tc + taa <- maybe NoGrandparentToPromoteUnder pure $ treeAboveAbove ta pure $ makeTreeCursorWithAbove g (currentTree f tc) $ Just $ taa { treeAboveLefts = - CNode - (treeAboveNode ta) - (openForest $ reverse (treeAboveLefts ta) ++ treeAboveRights ta) : + CNode (treeAboveNode ta) (openForest $ reverse (treeAboveLefts ta) ++ treeAboveRights ta) : treeAboveLefts taa } @@ -164,6 +142,8 @@ deriving (Show, Eq, Generic, Functor) instance Validity a => Validity (PromoteResult a) + +instance NFData a => NFData (PromoteResult a) instance Applicative PromoteResult where pure = Promoted diff --git a/src/Cursor/Tree/Swap.hs b/src/Cursor/Tree/Swap.hs --- a/src/Cursor/Tree/Swap.hs +++ b/src/Cursor/Tree/Swap.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveFunctor #-} @@ -13,6 +12,8 @@ import GHC.Generics (Generic) +import Control.DeepSeq + import Cursor.Tree.Types -- | Swaps the current node with the previous node on the same level @@ -31,7 +32,7 @@ -- > |- b <-- -- > |- a treeCursorSwapPrev :: TreeCursor a b -> SwapResult (TreeCursor a b) -treeCursorSwapPrev tc = do +treeCursorSwapPrev tc = case treeAbove tc of Nothing -> SwapperIsTopNode Just ta -> @@ -39,14 +40,7 @@ [] -> NoSiblingsToSwapWith (t:ts) -> Swapped $ - tc - { treeAbove = - Just - ta - { treeAboveLefts = ts - , treeAboveRights = t : treeAboveRights ta - } - } + tc {treeAbove = Just ta {treeAboveLefts = ts, treeAboveRights = t : treeAboveRights ta}} -- | Swaps the current node with the next node on the same level -- @@ -72,14 +66,7 @@ [] -> NoSiblingsToSwapWith (t:ts) -> Swapped $ - tc - { treeAbove = - Just - ta - { treeAboveLefts = t : treeAboveLefts ta - , treeAboveRights = ts - } - } + tc {treeAbove = Just ta {treeAboveLefts = t : treeAboveLefts ta, treeAboveRights = ts}} data SwapResult a = SwapperIsTopNode @@ -88,3 +75,5 @@ deriving (Show, Eq, Generic, Functor) instance Validity a => Validity (SwapResult a) + +instance NFData a => NFData (SwapResult a) diff --git a/src/Cursor/Tree/Types.hs b/src/Cursor/Tree/Types.hs --- a/src/Cursor/Tree/Types.hs +++ b/src/Cursor/Tree/Types.hs @@ -1,5 +1,4 @@ {-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DeriveFunctor #-} @@ -31,13 +30,15 @@ , unpackCForest ) where +import GHC.Generics (Generic) + 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 Control.DeepSeq import Lens.Micro @@ -45,26 +46,26 @@ TreeCursor { treeAbove :: !(Maybe (TreeAbove b)) , treeCurrent :: !a - , treeBelow :: (CForest b) + , treeBelow :: !(CForest b) } deriving (Show, Eq, Generic) +instance (Validity a, Validity b) => Validity (TreeCursor a b) + +instance (NFData a, NFData b) => NFData (TreeCursor a b) + treeCursorAboveL :: Lens' (TreeCursor a b) (Maybe (TreeAbove b)) treeCursorAboveL = lens treeAbove $ \tc ta -> tc {treeAbove = ta} -treeCursorCurrentL :: Lens' (TreeCursor a b) a +treeCursorCurrentL :: Lens (TreeCursor a b) (TreeCursor a' b) a 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 (TreeCursor a b) (TreeCursor a' b) (a, CForest 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) + lens (\tc -> (treeCurrent tc, treeBelow tc)) (\tc (a, cf) -> tc {treeCurrent = a, treeBelow = cf}) data TreeAbove b = TreeAbove @@ -77,6 +78,8 @@ instance Validity b => Validity (TreeAbove b) +instance NFData b => NFData (TreeAbove b) + treeAboveLeftsL :: Lens' (TreeAbove b) [CTree b] treeAboveLeftsL = lens treeAboveLefts $ \ta tal -> ta {treeAboveLefts = tal} @@ -96,12 +99,16 @@ instance Validity TreeCursorSelection +instance NFData TreeCursorSelection + data CTree a = CNode !a (CForest a) deriving (Show, Eq, Generic, Functor) instance Validity a => Validity (CTree a) +instance NFData a => NFData (CTree a) + makeCTree :: Tree a -> CTree a makeCTree = cTree False @@ -119,6 +126,8 @@ instance Validity a => Validity (CForest a) +instance NFData a => NFData (CForest a) + makeCForest :: Forest a -> CForest a makeCForest = cForest True @@ -137,16 +146,10 @@ emptyCForest = EmptyCForest openForest :: [CTree a] -> CForest a -openForest ts = - case NE.nonEmpty ts of - Nothing -> emptyCForest - Just ne -> OpenForest ne +openForest ts = maybe emptyCForest OpenForest $ NE.nonEmpty ts closedForest :: [Tree a] -> CForest a -closedForest ts = - case NE.nonEmpty ts of - Nothing -> emptyCForest - Just ne -> ClosedForest ne +closedForest ts = maybe emptyCForest ClosedForest $ NE.nonEmpty ts lengthCForest :: CForest a -> Int lengthCForest EmptyCForest = 0