-- DEPRECATED, we will switch to Owl :O

module Potato.Flow.Deprecated.Layers (
  reindexSEltLayerPosForRemoval
  , reindexSEltLayerPosForInsertion
  , hasScopingProperty
  , selectionHasScopingProperty
  , findMatchingScope
  , scopeSelection
  , insertElts
  , insertElt
  , removeElts
  , insertEltList_indexBeforeInsertion
  , insertEltList_indexAfterInsertion
  , removeEltList
  , moveEltList
  , undoMoveEltList
) where

import           Relude

import           Potato.Flow.Types

import           Control.Exception (assert)
import qualified Data.Bimap        as BM
import           Data.List.Ordered (isSorted)
import           Data.Sequence     ((><))
import qualified Data.Sequence     as Seq
import qualified Data.Set          as Set

-- copy pasta https://stackoverflow.com/questions/16108714/removing-duplicates-from-a-list-in-haskell-without-elem
sortUnique :: Ord a => [a] -> [a]
sortUnique :: forall a. Ord a => [a] -> [a]
sortUnique = [a] -> [a]
forall a. Ord a => [a] -> [a]
sort ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a] -> [a]
forall {a}. Ord a => Set a -> [a] -> [a]
rmdups' Set a
forall a. Set a
Set.empty where
  rmdups' :: Set a -> [a] -> [a]
rmdups' Set a
_ [] = []
  rmdups' Set a
a (a
b : [a]
c) = if a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
b Set a
a
    then Set a -> [a] -> [a]
rmdups' Set a
a [a]
c
    else a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: Set a -> [a] -> [a]
rmdups' (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
Set.insert a
b Set a
a) [a]
c

-- | reindexes list of LayerPos such that each element is indexed as if all previous elements have been removed
-- O(n^2) lol
reindexSEltLayerPosForRemoval :: [LayerPos] -> [LayerPos]
reindexSEltLayerPosForRemoval :: [LayerPos] -> [LayerPos]
reindexSEltLayerPosForRemoval [] = []
reindexSEltLayerPosForRemoval (LayerPos
r:[LayerPos]
xs) = LayerPos
rLayerPos -> [LayerPos] -> [LayerPos]
forall a. a -> [a] -> [a]
:[LayerPos] -> [LayerPos]
reindexSEltLayerPosForRemoval [LayerPos]
rest where
  -- if this asserts that means you tried to remove the same index twice
  rest :: [LayerPos]
rest = (LayerPos -> LayerPos) -> [LayerPos] -> [LayerPos]
forall a b. (a -> b) -> [a] -> [b]
map (\LayerPos
x -> Bool -> LayerPos -> LayerPos
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (LayerPos
x LayerPos -> LayerPos -> Bool
forall a. Eq a => a -> a -> Bool
/= LayerPos
r) (LayerPos -> LayerPos) -> LayerPos -> LayerPos
forall a b. (a -> b) -> a -> b
$ if LayerPos
x LayerPos -> LayerPos -> Bool
forall a. Ord a => a -> a -> Bool
> LayerPos
r then LayerPos
xLayerPos -> LayerPos -> LayerPos
forall a. Num a => a -> a -> a
-LayerPos
1 else LayerPos
x) [LayerPos]
xs

-- | inverse of reindexSEltLayerPosForRemoval
-- input indices are before any elements are inserted
-- O(n^2) lol
reindexSEltLayerPosForInsertion :: [LayerPos] -> [LayerPos]
reindexSEltLayerPosForInsertion :: [LayerPos] -> [LayerPos]
reindexSEltLayerPosForInsertion = [LayerPos] -> [LayerPos]
forall a. [a] -> [a]
reverse ([LayerPos] -> [LayerPos])
-> ([LayerPos] -> [LayerPos]) -> [LayerPos] -> [LayerPos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LayerPos] -> [LayerPos]
reindexSEltLayerPosForRemoval ([LayerPos] -> [LayerPos])
-> ([LayerPos] -> [LayerPos]) -> [LayerPos] -> [LayerPos]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LayerPos] -> [LayerPos]
forall a. [a] -> [a]
reverse


hasScopingProperty :: (a -> Maybe Bool) -> Seq a -> Bool
hasScopingProperty :: forall a. (a -> Maybe Bool) -> Seq a -> Bool
hasScopingProperty a -> Maybe Bool
scopeTypeFn Seq a
xs = Bool -> Bool
not Bool
finalFail Bool -> Bool -> Bool
&& LayerPos
finalScope LayerPos -> LayerPos -> Bool
forall a. Eq a => a -> a -> Bool
== LayerPos
0 where
  foldfn :: a -> (LayerPos, Bool) -> (LayerPos, Bool)
foldfn a
x (LayerPos
scopes, Bool
didFail) = case a -> Maybe Bool
scopeTypeFn a
x of
    Maybe Bool
Nothing -> (LayerPos
scopes, Bool
didFail)
    Just Bool
f -> case Bool
f of
      Bool
True -> case LayerPos
scopes of
        LayerPos
0 -> (LayerPos
scopes, Bool
True)
        LayerPos
_ -> (LayerPos
scopesLayerPos -> LayerPos -> LayerPos
forall a. Num a => a -> a -> a
-LayerPos
1, Bool
didFail)
      Bool
False -> (LayerPos
scopesLayerPos -> LayerPos -> LayerPos
forall a. Num a => a -> a -> a
+LayerPos
1, Bool
didFail)
  (LayerPos
finalScope, Bool
finalFail) = (a -> (LayerPos, Bool) -> (LayerPos, Bool))
-> (LayerPos, Bool) -> Seq a -> (LayerPos, Bool)
forall a b. (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> (LayerPos, Bool) -> (LayerPos, Bool)
foldfn (LayerPos
0 :: Int, Bool
False) Seq a
xs

-- | assumes selection is ordered and is valid
selectionHasScopingProperty :: (a -> Maybe Bool) -> Seq a -> [Int] -> Bool
selectionHasScopingProperty :: forall a. (a -> Maybe Bool) -> Seq a -> [LayerPos] -> Bool
selectionHasScopingProperty a -> Maybe Bool
scopeTypeFn Seq a
xs [LayerPos]
is = (a -> Maybe Bool) -> Seq a -> Bool
forall a. (a -> Maybe Bool) -> Seq a -> Bool
hasScopingProperty a -> Maybe Bool
scopeTypeFn Seq a
subSeq where
  subSeq :: Seq a
subSeq = [a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList ([a] -> Seq a) -> [a] -> Seq a
forall a b. (a -> b) -> a -> b
$ (LayerPos -> a) -> [LayerPos] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\LayerPos
i -> Seq a -> LayerPos -> a
forall a. Seq a -> LayerPos -> a
Seq.index Seq a
xs LayerPos
i) [LayerPos]
is

makePairMap :: (a -> Maybe Bool) -> Seq a -> BM.Bimap Int Int
makePairMap :: forall a. (a -> Maybe Bool) -> Seq a -> Bimap LayerPos LayerPos
makePairMap a -> Maybe Bool
scopeTypeFn Seq a
xs = (Bimap LayerPos LayerPos, [LayerPos]) -> Bimap LayerPos LayerPos
forall a b. (a, b) -> a
fst (Bimap LayerPos LayerPos, [LayerPos])
r where
  -- map folders from start to end index
  pairmapfoldfn :: LayerPos
-> a
-> (Bimap LayerPos LayerPos, [LayerPos])
-> (Bimap LayerPos LayerPos, [LayerPos])
pairmapfoldfn LayerPos
i a
a (Bimap LayerPos LayerPos
pairs, [LayerPos]
scopes) = case a -> Maybe Bool
scopeTypeFn a
a of
    Maybe Bool
Nothing -> (Bimap LayerPos LayerPos
pairs, [LayerPos]
scopes)
    Just Bool
True -> case [LayerPos]
scopes of
      []        -> Text -> (Bimap LayerPos LayerPos, [LayerPos])
forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"mismatched scopes"
      LayerPos
x:[LayerPos]
scopes' -> (LayerPos
-> LayerPos -> Bimap LayerPos LayerPos -> Bimap LayerPos LayerPos
forall a b. (Ord a, Ord b) => a -> b -> Bimap a b -> Bimap a b
BM.insert LayerPos
i LayerPos
x Bimap LayerPos LayerPos
pairs, [LayerPos]
scopes')
    Just Bool
False -> (Bimap LayerPos LayerPos
pairs, LayerPos
iLayerPos -> [LayerPos] -> [LayerPos]
forall a. a -> [a] -> [a]
:[LayerPos]
scopes)
  r :: (Bimap LayerPos LayerPos, [LayerPos])
r = (LayerPos
 -> a
 -> (Bimap LayerPos LayerPos, [LayerPos])
 -> (Bimap LayerPos LayerPos, [LayerPos]))
-> (Bimap LayerPos LayerPos, [LayerPos])
-> Seq a
-> (Bimap LayerPos LayerPos, [LayerPos])
forall a b. (LayerPos -> a -> b -> b) -> b -> Seq a -> b
Seq.foldrWithIndex LayerPos
-> a
-> (Bimap LayerPos LayerPos, [LayerPos])
-> (Bimap LayerPos LayerPos, [LayerPos])
pairmapfoldfn (Bimap LayerPos LayerPos
forall a b. Bimap a b
BM.empty,[]) Seq a
xs

-- assumes input sequence satisfies scoping property
-- assumes input index is actually a folder
findMatchingScope :: (a -> Maybe Bool) -> Seq a -> Int -> Int
findMatchingScope :: forall a. (a -> Maybe Bool) -> Seq a -> LayerPos -> LayerPos
findMatchingScope a -> Maybe Bool
scopeTypeFn Seq a
xs LayerPos
i = LayerPos
r where
  pairmap :: Bimap LayerPos LayerPos
pairmap = (a -> Maybe Bool) -> Seq a -> Bimap LayerPos LayerPos
forall a. (a -> Maybe Bool) -> Seq a -> Bimap LayerPos LayerPos
makePairMap a -> Maybe Bool
scopeTypeFn Seq a
xs
  r :: LayerPos
r = case a -> Maybe Bool
scopeTypeFn (Seq a -> LayerPos -> a
forall a. Seq a -> LayerPos -> a
Seq.index Seq a
xs LayerPos
i) of
    Maybe Bool
Nothing -> Text -> LayerPos
forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"input index was not a folder"
    Just Bool
True -> case LayerPos -> Bimap LayerPos LayerPos -> Maybe LayerPos
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
BM.lookup LayerPos
i Bimap LayerPos LayerPos
pairmap of
      Maybe LayerPos
Nothing -> Text -> LayerPos
forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"pairmap missing elements, this means scopes were mismatched"
      Just LayerPos
x -> LayerPos
x
    Just Bool
False -> case LayerPos -> Bimap LayerPos LayerPos -> Maybe LayerPos
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
BM.lookupR LayerPos
i Bimap LayerPos LayerPos
pairmap of
      Maybe LayerPos
Nothing -> Text -> LayerPos
forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"pairmap missing elements, this means scopes were mismatched"
      Just LayerPos
x -> LayerPos
x

-- | converts selection so that it satisfies the scoping property by adding matching folders
-- assumes input sequence satisfies scoping property???
-- simple and inefficient implementation, do not use in prod
scopeSelection :: (a -> Maybe Bool) -> Seq a -> [Int] -> [Int]
scopeSelection :: forall a. (a -> Maybe Bool) -> Seq a -> [LayerPos] -> [LayerPos]
scopeSelection a -> Maybe Bool
scopeTypeFn Seq a
xs [LayerPos]
is = [LayerPos]
r where
  pairmap :: Bimap LayerPos LayerPos
pairmap = (a -> Maybe Bool) -> Seq a -> Bimap LayerPos LayerPos
forall a. (a -> Maybe Bool) -> Seq a -> Bimap LayerPos LayerPos
makePairMap a -> Maybe Bool
scopeTypeFn Seq a
xs
  -- go through and lookup matches
  foldfn :: LayerPos -> [LayerPos] -> [LayerPos]
foldfn LayerPos
i [LayerPos]
acc = case a -> Maybe Bool
scopeTypeFn (Seq a -> LayerPos -> a
forall a. Seq a -> LayerPos -> a
Seq.index Seq a
xs LayerPos
i) of
    Maybe Bool
Nothing -> [LayerPos]
acc
    Just Bool
True -> case LayerPos -> Bimap LayerPos LayerPos -> Maybe LayerPos
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
a -> Bimap a b -> m b
BM.lookup LayerPos
i Bimap LayerPos LayerPos
pairmap of
      Maybe LayerPos
Nothing -> Text -> [LayerPos]
forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"pairmap missing elements, this means scopes were mismatched"
      Just LayerPos
x -> LayerPos
xLayerPos -> [LayerPos] -> [LayerPos]
forall a. a -> [a] -> [a]
:[LayerPos]
acc
    Just Bool
False -> case LayerPos -> Bimap LayerPos LayerPos -> Maybe LayerPos
forall a b (m :: * -> *).
(Ord a, Ord b, MonadThrow m) =>
b -> Bimap a b -> m a
BM.lookupR LayerPos
i Bimap LayerPos LayerPos
pairmap of
      Maybe LayerPos
Nothing -> Text -> [LayerPos]
forall a t. (?callStack::CallStack, IsText t) => t -> a
error Text
"pairmap missing elements, this means scopes were mismatched"
      Just LayerPos
x -> LayerPos
xLayerPos -> [LayerPos] -> [LayerPos]
forall a. a -> [a] -> [a]
:[LayerPos]
acc
  newElts :: [LayerPos]
newElts = (LayerPos -> [LayerPos] -> [LayerPos])
-> [LayerPos] -> [LayerPos] -> [LayerPos]
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LayerPos -> [LayerPos] -> [LayerPos]
foldfn [] [LayerPos]
is
  r :: [LayerPos]
r = [LayerPos] -> [LayerPos]
forall a. Ord a => [a] -> [a]
sortUnique ([LayerPos]
newElts [LayerPos] -> [LayerPos] -> [LayerPos]
forall a. Semigroup a => a -> a -> a
<> [LayerPos]
is)


-- | inserts ys at index i into xs
insertElts :: Int -> Seq a -> Seq a -> Seq a
insertElts :: forall a. LayerPos -> Seq a -> Seq a -> Seq a
insertElts LayerPos
i Seq a
ys Seq a
xs = Seq a
newSeq where
  (Seq a
l, Seq a
r) = LayerPos -> Seq a -> (Seq a, Seq a)
forall a. LayerPos -> Seq a -> (Seq a, Seq a)
Seq.splitAt LayerPos
i Seq a
xs
  newSeq :: Seq a
newSeq = Seq a
l Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
ys Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
r

-- | inserts y at index y into xs
insertElt :: Int -> a -> Seq a -> Seq a
insertElt :: forall a. LayerPos -> a -> Seq a -> Seq a
insertElt LayerPos
i a
y Seq a
xs = LayerPos -> Seq a -> Seq a -> Seq a
forall a. LayerPos -> Seq a -> Seq a -> Seq a
insertElts LayerPos
i (a -> Seq a
forall a. a -> Seq a
Seq.singleton a
y) Seq a
xs

-- | removes n elts at index i from xs
removeElts :: Int -> Int -> Seq a -> Seq a
removeElts :: forall a. LayerPos -> LayerPos -> Seq a -> Seq a
removeElts LayerPos
n LayerPos
i Seq a
xs = Seq a
newSeq where
  (Seq a
keepl  , Seq a
rs) = LayerPos -> Seq a -> (Seq a, Seq a)
forall a. LayerPos -> Seq a -> (Seq a, Seq a)
Seq.splitAt LayerPos
i Seq a
xs
  (Seq a
_, Seq a
keepr) = LayerPos -> Seq a -> (Seq a, Seq a)
forall a. LayerPos -> Seq a -> (Seq a, Seq a)
Seq.splitAt LayerPos
n Seq a
rs
  newSeq :: Seq a
newSeq           = Seq a
keepl Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
keepr

-- | removes elt at index i from xs
removeElt :: Int -> Seq a -> Seq a
removeElt :: forall a. LayerPos -> Seq a -> Seq a
removeElt LayerPos
i Seq a
xs = LayerPos -> Seq a -> Seq a
forall a. LayerPos -> Seq a -> Seq a
Seq.deleteAt LayerPos
i Seq a
xs

-- | inserts ys into xs, positions are before insertion
insertEltList_indexBeforeInsertion :: [(Int, a)] -> Seq a -> Seq a
insertEltList_indexBeforeInsertion :: forall a. [(LayerPos, a)] -> Seq a -> Seq a
insertEltList_indexBeforeInsertion [(LayerPos, a)]
ys Seq a
xs = Bool -> Seq a -> Seq a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([LayerPos] -> Bool
forall a. Ord a => [a] -> Bool
isSorted [LayerPos]
is') (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a
newSeq where
  is' :: [LayerPos]
is' = ((LayerPos, a) -> LayerPos) -> [(LayerPos, a)] -> [LayerPos]
forall a b. (a -> b) -> [a] -> [b]
map (LayerPos, a) -> LayerPos
forall a b. (a, b) -> a
fst [(LayerPos, a)]
ys
  elts :: [a]
elts = ((LayerPos, a) -> a) -> [(LayerPos, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (LayerPos, a) -> a
forall a b. (a, b) -> b
snd [(LayerPos, a)]
ys
  is :: [LayerPos]
is = [LayerPos] -> [LayerPos]
reindexSEltLayerPosForInsertion [LayerPos]
is'
  newSeq :: Seq a
newSeq = ((LayerPos, a) -> Seq a -> Seq a)
-> Seq a -> [(LayerPos, a)] -> Seq a
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ((LayerPos -> a -> Seq a -> Seq a)
-> (LayerPos, a) -> Seq a -> Seq a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LayerPos -> a -> Seq a -> Seq a
forall a. LayerPos -> a -> Seq a -> Seq a
insertElt) Seq a
xs ([LayerPos] -> [a] -> [(LayerPos, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LayerPos]
is [a]
elts)

-- | inserts ys into xs, positions are after insertion
insertEltList_indexAfterInsertion :: [(Int, a)] -> Seq a -> Seq a
insertEltList_indexAfterInsertion :: forall a. [(LayerPos, a)] -> Seq a -> Seq a
insertEltList_indexAfterInsertion [(LayerPos, a)]
ys Seq a
xs = Bool -> Seq a -> Seq a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([LayerPos] -> Bool
forall a. Ord a => [a] -> Bool
isSorted [LayerPos]
is) (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a
newSeq where
  is :: [LayerPos]
is = ((LayerPos, a) -> LayerPos) -> [(LayerPos, a)] -> [LayerPos]
forall a b. (a -> b) -> [a] -> [b]
map (LayerPos, a) -> LayerPos
forall a b. (a, b) -> a
fst [(LayerPos, a)]
ys
  newSeq :: Seq a
newSeq = (Seq a -> (LayerPos, a) -> Seq a)
-> Seq a -> [(LayerPos, a)] -> Seq a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (((LayerPos, a) -> Seq a -> Seq a)
-> Seq a -> (LayerPos, a) -> Seq a
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((LayerPos -> a -> Seq a -> Seq a)
-> (LayerPos, a) -> Seq a -> Seq a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LayerPos -> a -> Seq a -> Seq a
forall a. LayerPos -> a -> Seq a -> Seq a
insertElt)) Seq a
xs [(LayerPos, a)]
ys

-- | removes is' from xs, positions are before removal
removeEltList :: [Int] -> Seq a -> Seq a
removeEltList :: forall a. [LayerPos] -> Seq a -> Seq a
removeEltList [LayerPos]
is' Seq a
xs = Bool -> Seq a -> Seq a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([LayerPos] -> Bool
forall a. Ord a => [a] -> Bool
isSorted [LayerPos]
is) (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a
newSeq where
  is :: [LayerPos]
is = [LayerPos] -> [LayerPos]
reindexSEltLayerPosForRemoval [LayerPos]
is'
  newSeq :: Seq a
newSeq = (Seq a -> LayerPos -> Seq a) -> Seq a -> [LayerPos] -> Seq a
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' ((LayerPos -> Seq a -> Seq a) -> Seq a -> LayerPos -> Seq a
forall a b c. (a -> b -> c) -> b -> a -> c
flip LayerPos -> Seq a -> Seq a
forall a. LayerPos -> Seq a -> Seq a
removeElt) Seq a
xs [LayerPos]
is

-- | moves all elts, new position is before removal, ys must be sorted
moveEltList :: [Int] -> Int -> Seq a -> Seq a
moveEltList :: forall a. [LayerPos] -> LayerPos -> Seq a -> Seq a
moveEltList [LayerPos]
is LayerPos
i Seq a
xs = Bool -> Seq a -> Seq a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([LayerPos] -> Bool
forall a. Ord a => [a] -> Bool
isSorted [LayerPos]
is) (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a
newSeq where
  nBefore :: LayerPos
nBefore = [LayerPos] -> LayerPos
forall a. [a] -> LayerPos
forall (t :: * -> *) a. Foldable t => t a -> LayerPos
length ([LayerPos] -> LayerPos)
-> ([LayerPos] -> [LayerPos]) -> [LayerPos] -> LayerPos
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LayerPos -> Bool) -> [LayerPos] -> [LayerPos]
forall a. (a -> Bool) -> [a] -> [a]
filter (LayerPos -> LayerPos -> Bool
forall a. Ord a => a -> a -> Bool
< LayerPos
i) ([LayerPos] -> LayerPos) -> [LayerPos] -> LayerPos
forall a b. (a -> b) -> a -> b
$ [LayerPos]
is
  ys :: [a]
ys = (LayerPos -> a) -> [LayerPos] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Seq a -> LayerPos -> a
forall a. Seq a -> LayerPos -> a
Seq.index Seq a
xs) [LayerPos]
is
  newSeq' :: Seq a
newSeq' = [LayerPos] -> Seq a -> Seq a
forall a. [LayerPos] -> Seq a -> Seq a
removeEltList [LayerPos]
is Seq a
xs
  newSeq :: Seq a
newSeq = LayerPos -> Seq a -> Seq a -> Seq a
forall a. LayerPos -> Seq a -> Seq a -> Seq a
insertElts (LayerPos
iLayerPos -> LayerPos -> LayerPos
forall a. Num a => a -> a -> a
-LayerPos
nBefore) ([a] -> Seq a
forall a. [a] -> Seq a
Seq.fromList [a]
ys) Seq a
newSeq'

-- inverse of `moveEltList`
undoMoveEltList :: [Int] -> Int -> Seq a -> Seq a
undoMoveEltList :: forall a. [LayerPos] -> LayerPos -> Seq a -> Seq a
undoMoveEltList [LayerPos]
is LayerPos
i Seq a
xs = Bool -> Seq a -> Seq a
forall a. (?callStack::CallStack) => Bool -> a -> a
assert ([LayerPos] -> Bool
forall a. Ord a => [a] -> Bool
isSorted [LayerPos]
is) (Seq a -> Seq a) -> Seq a -> Seq a
forall a b. (a -> b) -> a -> b
$ Seq a
newSeq where
  nMoved :: LayerPos
nMoved = [LayerPos] -> LayerPos
forall a. [a] -> LayerPos
forall (t :: * -> *) a. Foldable t => t a -> LayerPos
length [LayerPos]
is
  moveToIndex :: LayerPos
moveToIndex = LayerPos
i LayerPos -> LayerPos -> LayerPos
forall a. Num a => a -> a -> a
- ([LayerPos] -> LayerPos
forall a. [a] -> LayerPos
forall (t :: * -> *) a. Foldable t => t a -> LayerPos
length ((LayerPos -> Bool) -> [LayerPos] -> [LayerPos]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (\LayerPos
x -> LayerPos
x LayerPos -> LayerPos -> Bool
forall a. Ord a => a -> a -> Bool
< LayerPos
i) [LayerPos]
is))
  (Seq a
leftL,Seq a
rightL') = LayerPos -> Seq a -> (Seq a, Seq a)
forall a. LayerPos -> Seq a -> (Seq a, Seq a)
Seq.splitAt LayerPos
moveToIndex Seq a
xs
  (Seq a
toMove,Seq a
rightL) = LayerPos -> Seq a -> (Seq a, Seq a)
forall a. LayerPos -> Seq a -> (Seq a, Seq a)
Seq.splitAt LayerPos
nMoved Seq a
rightL'
  newSeq' :: Seq a
newSeq' = Seq a
leftL Seq a -> Seq a -> Seq a
forall a. Seq a -> Seq a -> Seq a
>< Seq a
rightL
  newSeq :: Seq a
newSeq = [(LayerPos, a)] -> Seq a -> Seq a
forall a. [(LayerPos, a)] -> Seq a -> Seq a
insertEltList_indexAfterInsertion ([LayerPos] -> [a] -> [(LayerPos, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LayerPos]
is (Seq a -> [a]
forall a. Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
toMove)) Seq a
newSeq'