{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}
module Data.FocusList
(
FocusList(FocusList, focusListFocus, focusList)
, fromListFL
, fromFoldableFL
, toSeqFL
, lengthFL
, isEmptyFL
, getFocusItemFL
, lookupFL
, indexOfFL
, findFL
, hasFocusFL
, getFocusFL
, prependFL
, appendFL
, appendSetFocusFL
, insertFL
, removeFL
, deleteFL
, moveFromToFL
, intersperseFL
, reverseFL
, updateFocusItemFL
, setFocusItemFL
,
traversalFocusItem
, setFocusFL
, updateFocusFL
, sortByFL
, emptyFL
, singletonFL
, unsafeFromListFL
, unsafeGetFocusFL
, unsafeGetFocusItemFL
, invariantFL
, genValidFL
, lensFocusListFocus
, lensFocusList
, Focus(Focus, NoFocus)
, hasFocus
, getFocus
, maybeToFocus
, foldFocus
, _Focus
, _NoFocus
, unsafeGetFocus
) where
import Prelude hiding (reverse)
import Control.Lens (Prism', Traversal', (^.), (.~), (-~), makeLensesFor, prism')
import Data.Foldable (toList)
import Data.Function ((&))
import Data.MonoTraversable
(Element, GrowingAppend, MonoFoldable, MonoFunctor, MonoTraversable, olength)
import qualified Data.Sequence as Sequence
import Data.Sequence
(Seq((:<|), Empty), (<|), deleteAt, elemIndexL, insertAt, singleton)
import Data.Sequences
(Index, SemiSequence, cons, find, intersperse, reverse, snoc, sortBy)
import GHC.Exts (fromList)
import GHC.Generics (Generic)
import Test.QuickCheck
( Arbitrary, Arbitrary1, CoArbitrary, Gen, arbitrary, arbitrary1, choose
, frequency, liftArbitrary
)
data Focus = Focus {-# UNPACK #-} !Int | NoFocus deriving (Focus -> Focus -> Bool
(Focus -> Focus -> Bool) -> (Focus -> Focus -> Bool) -> Eq Focus
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Focus -> Focus -> Bool
$c/= :: Focus -> Focus -> Bool
== :: Focus -> Focus -> Bool
$c== :: Focus -> Focus -> Bool
Eq, (forall x. Focus -> Rep Focus x)
-> (forall x. Rep Focus x -> Focus) -> Generic Focus
forall x. Rep Focus x -> Focus
forall x. Focus -> Rep Focus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Focus x -> Focus
$cfrom :: forall x. Focus -> Rep Focus x
Generic, ReadPrec [Focus]
ReadPrec Focus
Int -> ReadS Focus
ReadS [Focus]
(Int -> ReadS Focus)
-> ReadS [Focus]
-> ReadPrec Focus
-> ReadPrec [Focus]
-> Read Focus
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Focus]
$creadListPrec :: ReadPrec [Focus]
readPrec :: ReadPrec Focus
$creadPrec :: ReadPrec Focus
readList :: ReadS [Focus]
$creadList :: ReadS [Focus]
readsPrec :: Int -> ReadS Focus
$creadsPrec :: Int -> ReadS Focus
Read, Int -> Focus -> ShowS
[Focus] -> ShowS
Focus -> String
(Int -> Focus -> ShowS)
-> (Focus -> String) -> ([Focus] -> ShowS) -> Show Focus
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Focus] -> ShowS
$cshowList :: [Focus] -> ShowS
show :: Focus -> String
$cshow :: Focus -> String
showsPrec :: Int -> Focus -> ShowS
$cshowsPrec :: Int -> Focus -> ShowS
Show)
instance Ord Focus where
compare :: Focus -> Focus -> Ordering
compare :: Focus -> Focus -> Ordering
compare Focus
NoFocus Focus
NoFocus = Ordering
EQ
compare Focus
NoFocus (Focus Int
_) = Ordering
LT
compare (Focus Int
_) Focus
NoFocus = Ordering
GT
compare (Focus Int
a) (Focus Int
b) = Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
a Int
b
instance CoArbitrary Focus
instance Arbitrary Focus where
arbitrary :: Gen Focus
arbitrary = [(Int, Gen Focus)] -> Gen Focus
forall a. [(Int, Gen a)] -> Gen a
frequency [(Int
1, Focus -> Gen Focus
forall (f :: * -> *) a. Applicative f => a -> f a
pure Focus
NoFocus), (Int
3, (Int -> Focus) -> Gen Int -> Gen Focus
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Focus
Focus Gen Int
forall a. Arbitrary a => Gen a
arbitrary)]
foldFocus :: b -> (Int -> b) -> Focus -> b
foldFocus :: b -> (Int -> b) -> Focus -> b
foldFocus b
b Int -> b
_ Focus
NoFocus = b
b
foldFocus b
_ Int -> b
f (Focus Int
i) = Int -> b
f Int
i
_Focus :: Prism' Focus Int
_Focus :: p Int (f Int) -> p Focus (f Focus)
_Focus = (Int -> Focus) -> (Focus -> Maybe Int) -> Prism Focus Focus Int Int
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Int -> Focus
Focus (Maybe Int -> (Int -> Maybe Int) -> Focus -> Maybe Int
forall b. b -> (Int -> b) -> Focus -> b
foldFocus Maybe Int
forall a. Maybe a
Nothing Int -> Maybe Int
forall a. a -> Maybe a
Just)
_NoFocus :: Prism' Focus ()
_NoFocus :: p () (f ()) -> p Focus (f Focus)
_NoFocus = (() -> Focus) -> (Focus -> Maybe ()) -> Prism Focus Focus () ()
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' (Focus -> () -> Focus
forall a b. a -> b -> a
const Focus
NoFocus) (Maybe () -> (Int -> Maybe ()) -> Focus -> Maybe ()
forall b. b -> (Int -> b) -> Focus -> b
foldFocus (() -> Maybe ()
forall a. a -> Maybe a
Just ()) (Maybe () -> Int -> Maybe ()
forall a b. a -> b -> a
const Maybe ()
forall a. Maybe a
Nothing))
hasFocus :: Focus -> Bool
hasFocus :: Focus -> Bool
hasFocus Focus
NoFocus = Bool
False
hasFocus (Focus Int
_) = Bool
True
getFocus :: Focus -> Maybe Int
getFocus :: Focus -> Maybe Int
getFocus Focus
NoFocus = Maybe Int
forall a. Maybe a
Nothing
getFocus (Focus Int
i) = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
i
maybeToFocus :: Maybe Int -> Focus
maybeToFocus :: Maybe Int -> Focus
maybeToFocus Maybe Int
Nothing = Focus
NoFocus
maybeToFocus (Just Int
i) = Int -> Focus
Focus Int
i
unsafeGetFocus :: Focus -> Int
unsafeGetFocus :: Focus -> Int
unsafeGetFocus Focus
NoFocus = String -> Int
forall a. HasCallStack => String -> a
error String
"unsafeGetFocus: NoFocus"
unsafeGetFocus (Focus Int
i) = Int
i
data FocusList a = FocusList
{ FocusList a -> Focus
focusListFocus :: !Focus
, FocusList a -> Seq a
focusList :: !(Seq a)
} deriving (FocusList a -> FocusList a -> Bool
(FocusList a -> FocusList a -> Bool)
-> (FocusList a -> FocusList a -> Bool) -> Eq (FocusList a)
forall a. Eq a => FocusList a -> FocusList a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FocusList a -> FocusList a -> Bool
$c/= :: forall a. Eq a => FocusList a -> FocusList a -> Bool
== :: FocusList a -> FocusList a -> Bool
$c== :: forall a. Eq a => FocusList a -> FocusList a -> Bool
Eq, a -> FocusList b -> FocusList a
(a -> b) -> FocusList a -> FocusList b
(forall a b. (a -> b) -> FocusList a -> FocusList b)
-> (forall a b. a -> FocusList b -> FocusList a)
-> Functor FocusList
forall a b. a -> FocusList b -> FocusList a
forall a b. (a -> b) -> FocusList a -> FocusList b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> FocusList b -> FocusList a
$c<$ :: forall a b. a -> FocusList b -> FocusList a
fmap :: (a -> b) -> FocusList a -> FocusList b
$cfmap :: forall a b. (a -> b) -> FocusList a -> FocusList b
Functor, (forall x. FocusList a -> Rep (FocusList a) x)
-> (forall x. Rep (FocusList a) x -> FocusList a)
-> Generic (FocusList a)
forall x. Rep (FocusList a) x -> FocusList a
forall x. FocusList a -> Rep (FocusList a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FocusList a) x -> FocusList a
forall a x. FocusList a -> Rep (FocusList a) x
$cto :: forall a x. Rep (FocusList a) x -> FocusList a
$cfrom :: forall a x. FocusList a -> Rep (FocusList a) x
Generic)
$(makeLensesFor
[ ("focusListFocus", "lensFocusListFocus")
, ("focusList", "lensFocusList")
]
''FocusList
)
traversalFocusItem :: forall a. Traversal' (FocusList a) a
traversalFocusItem :: (a -> f a) -> FocusList a -> f (FocusList a)
traversalFocusItem a -> f a
f fl :: FocusList a
fl@FocusList {Focus
focusListFocus :: Focus
focusListFocus :: forall a. FocusList a -> Focus
focusListFocus, Seq a
focusList :: Seq a
focusList :: forall a. FocusList a -> Seq a
focusList} =
case Focus
focusListFocus of
Focus
NoFocus -> FocusList a -> f (FocusList a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FocusList a
fl
Focus Int
focus ->
case Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Sequence.lookup Int
focus Seq a
focusList of
Maybe a
Nothing ->
String -> f (FocusList a)
forall a. HasCallStack => String -> a
error (String -> f (FocusList a)) -> String -> f (FocusList a)
forall a b. (a -> b) -> a -> b
$
String
"traersalFLItem: internal error, focus (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
Int -> String
forall a. Show a => a -> String
show Int
focus String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
") doesnt exist in sequence"
Just a
a -> (a -> FocusList a) -> f a -> f (FocusList a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a' -> a -> FocusList a -> FocusList a
forall a. a -> FocusList a -> FocusList a
setFocusItemFL a
a' FocusList a
fl) (a -> f a
f a
a)
instance Foldable FocusList where
foldr :: (a -> b -> b) -> b -> FocusList a -> b
foldr a -> b -> b
f b
b (FocusList Focus
_ Seq a
fls) = (a -> b -> b) -> b -> Seq a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> b -> b
f b
b Seq a
fls
length :: FocusList a -> Int
length = FocusList a -> Int
forall a. FocusList a -> Int
lengthFL
instance Traversable FocusList where
traverse :: Applicative f => (a -> f b) -> FocusList a -> f (FocusList b)
traverse :: (a -> f b) -> FocusList a -> f (FocusList b)
traverse a -> f b
f (FocusList Focus
focus Seq a
fls) = Focus -> Seq b -> FocusList b
forall a. Focus -> Seq a -> FocusList a
FocusList Focus
focus (Seq b -> FocusList b) -> f (Seq b) -> f (FocusList b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> f b) -> Seq a -> f (Seq b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
f Seq a
fls
type instance Element (FocusList a) = a
instance MonoFunctor (FocusList a)
instance MonoFoldable (FocusList a) where
olength :: FocusList a -> Int
olength = FocusList a -> Int
forall a. FocusList a -> Int
lengthFL
instance MonoTraversable (FocusList a)
instance GrowingAppend (FocusList a)
instance SemiSequence (FocusList a) where
type Index (FocusList a) = Int
intersperse :: Element (FocusList a) -> FocusList a -> FocusList a
intersperse = Element (FocusList a) -> FocusList a -> FocusList a
forall a. a -> FocusList a -> FocusList a
intersperseFL
reverse :: FocusList a -> FocusList a
reverse = FocusList a -> FocusList a
forall a. FocusList a -> FocusList a
reverseFL
find :: (Element (FocusList a) -> Bool)
-> FocusList a -> Maybe (Element (FocusList a))
find = (Element (FocusList a) -> Bool)
-> FocusList a -> Maybe (Element (FocusList a))
forall a. (a -> Bool) -> FocusList a -> Maybe a
findFL
sortBy :: (Element (FocusList a) -> Element (FocusList a) -> Ordering)
-> FocusList a -> FocusList a
sortBy = (Element (FocusList a) -> Element (FocusList a) -> Ordering)
-> FocusList a -> FocusList a
forall a. (a -> a -> Ordering) -> FocusList a -> FocusList a
sortByFL
cons :: Element (FocusList a) -> FocusList a -> FocusList a
cons = Element (FocusList a) -> FocusList a -> FocusList a
forall a. a -> FocusList a -> FocusList a
prependFL
snoc :: FocusList a -> Element (FocusList a) -> FocusList a
snoc = FocusList a -> Element (FocusList a) -> FocusList a
forall a. FocusList a -> a -> FocusList a
appendFL
genValidFL :: forall a. Gen a -> Gen (FocusList a)
genValidFL :: Gen a -> Gen (FocusList a)
genValidFL Gen a
genA = do
FocusList a
newFL <- Gen (FocusList a)
genFL
if FocusList a -> Bool
forall a. FocusList a -> Bool
invariantFL FocusList a
newFL
then FocusList a -> Gen (FocusList a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FocusList a
newFL
else String -> Gen (FocusList a)
forall a. HasCallStack => String -> a
error String
"genValidFL generated an invalid FocusList! This should never happen!"
where
genFL :: Gen (FocusList a)
genFL :: Gen (FocusList a)
genFL = do
[a]
arbList <- Gen a -> Gen [a]
forall (f :: * -> *) a. Arbitrary1 f => Gen a -> Gen (f a)
liftArbitrary Gen a
genA
case [a]
arbList of
[] -> FocusList a -> Gen (FocusList a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure FocusList a
forall a. FocusList a
emptyFL
(a
_:[a]
_) -> do
let listLen :: Int
listLen = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
arbList
Int
len <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
listLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
FocusList a -> Gen (FocusList a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FocusList a -> Gen (FocusList a))
-> FocusList a -> Gen (FocusList a)
forall a b. (a -> b) -> a -> b
$ Focus -> [a] -> FocusList a
forall a. Focus -> [a] -> FocusList a
unsafeFromListFL (Int -> Focus
Focus Int
len) [a]
arbList
instance Arbitrary1 FocusList where
liftArbitrary :: Gen a -> Gen (FocusList a)
liftArbitrary = Gen a -> Gen (FocusList a)
forall a. Gen a -> Gen (FocusList a)
genValidFL
instance Arbitrary a => Arbitrary (FocusList a) where
arbitrary :: Gen (FocusList a)
arbitrary = Gen (FocusList a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1
instance CoArbitrary a => CoArbitrary (FocusList a)
instance Show a => Show (FocusList a) where
showsPrec :: Int -> FocusList a -> ShowS
showsPrec :: Int -> FocusList a -> ShowS
showsPrec Int
d FocusList{Seq a
Focus
focusList :: Seq a
focusListFocus :: Focus
focusList :: forall a. FocusList a -> Seq a
focusListFocus :: forall a. FocusList a -> Focus
..} =
Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
String -> ShowS
showString String
"FocusList " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> Focus -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Focus
focusListFocus ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> ShowS
showString String
" " ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Int -> [a] -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 (Seq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Seq a
focusList)
toSeqFL :: FocusList a -> Seq a
toSeqFL :: FocusList a -> Seq a
toSeqFL FocusList{focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls} = Seq a
fls
lengthFL :: FocusList a -> Int
lengthFL :: FocusList a -> Int
lengthFL = Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Seq a -> Int) -> (FocusList a -> Seq a) -> FocusList a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusList a -> Seq a
forall a. FocusList a -> Seq a
focusList
invariantFL :: FocusList a -> Bool
invariantFL :: FocusList a -> Bool
invariantFL FocusList a
fl =
Bool
invariantFocusNotNeg Bool -> Bool -> Bool
&&
Bool
invariantFocusInMap Bool -> Bool -> Bool
&&
Bool
invariantFocusIfLenGT0
where
invariantFocusNotNeg :: Bool
invariantFocusNotNeg :: Bool
invariantFocusNotNeg =
case FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus of
Focus
NoFocus -> Bool
True
Focus Int
i -> Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0
invariantFocusInMap :: Bool
invariantFocusInMap :: Bool
invariantFocusInMap =
case FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus of
Focus
NoFocus -> Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (FocusList a
fl FocusList a -> Getting (Seq a) (FocusList a) (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) (FocusList a) (Seq a)
forall a a. Lens (FocusList a) (FocusList a) (Seq a) (Seq a)
lensFocusList) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
Focus Int
i ->
case Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Sequence.lookup Int
i (FocusList a
fl FocusList a -> Getting (Seq a) (FocusList a) (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) (FocusList a) (Seq a)
forall a a. Lens (FocusList a) (FocusList a) (Seq a) (Seq a)
lensFocusList) of
Maybe a
Nothing -> Bool
False
Just a
_ -> Bool
True
invariantFocusIfLenGT0 :: Bool
invariantFocusIfLenGT0 :: Bool
invariantFocusIfLenGT0 =
let len :: Int
len = FocusList a -> Int
forall a. FocusList a -> Int
lengthFL FocusList a
fl
focus :: Focus
focus = FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus
in
case Focus
focus of
Focus Int
_ -> Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
Focus
NoFocus -> Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
unsafeFromListFL :: Focus -> [a] -> FocusList a
unsafeFromListFL :: Focus -> [a] -> FocusList a
unsafeFromListFL Focus
focus [a]
list =
FocusList :: forall a. Focus -> Seq a -> FocusList a
FocusList
{ focusListFocus :: Focus
focusListFocus = Focus
focus
, focusList :: Seq a
focusList = [Item (Seq a)] -> Seq a
forall l. IsList l => [Item l] -> l
fromList [a]
[Item (Seq a)]
list
}
fromListFL :: Focus -> [a] -> Maybe (FocusList a)
fromListFL :: Focus -> [a] -> Maybe (FocusList a)
fromListFL Focus
NoFocus [] = FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just FocusList a
forall a. FocusList a
emptyFL
fromListFL Focus
_ [] = Maybe (FocusList a)
forall a. Maybe a
Nothing
fromListFL Focus
NoFocus (a
_:[a]
_) = Maybe (FocusList a)
forall a. Maybe a
Nothing
fromListFL (Focus Int
i) [a]
list =
let len :: Int
len = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
list
in
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
then Maybe (FocusList a)
forall a. Maybe a
Nothing
else
FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just (FocusList a -> Maybe (FocusList a))
-> FocusList a -> Maybe (FocusList a)
forall a b. (a -> b) -> a -> b
$
FocusList :: forall a. Focus -> Seq a -> FocusList a
FocusList
{ focusListFocus :: Focus
focusListFocus = Int -> Focus
Focus Int
i
, focusList :: Seq a
focusList = [Item (Seq a)] -> Seq a
forall l. IsList l => [Item l] -> l
fromList [a]
[Item (Seq a)]
list
}
fromFoldableFL :: Foldable f => Focus -> f a -> Maybe (FocusList a)
fromFoldableFL :: Focus -> f a -> Maybe (FocusList a)
fromFoldableFL Focus
foc f a
as = Focus -> [a] -> Maybe (FocusList a)
forall a. Focus -> [a] -> Maybe (FocusList a)
fromListFL Focus
foc (f a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList f a
as)
singletonFL :: a -> FocusList a
singletonFL :: a -> FocusList a
singletonFL a
a =
FocusList :: forall a. Focus -> Seq a -> FocusList a
FocusList
{ focusListFocus :: Focus
focusListFocus = Int -> Focus
Focus Int
0
, focusList :: Seq a
focusList = a -> Seq a
forall a. a -> Seq a
singleton a
a
}
emptyFL :: FocusList a
emptyFL :: FocusList a
emptyFL =
FocusList :: forall a. Focus -> Seq a -> FocusList a
FocusList
{ focusListFocus :: Focus
focusListFocus = Focus
NoFocus
, focusList :: Seq a
focusList = Seq a
forall a. Monoid a => a
mempty
}
isEmptyFL :: FocusList a -> Bool
isEmptyFL :: FocusList a -> Bool
isEmptyFL FocusList a
fl = (FocusList a -> Int
forall a. FocusList a -> Int
lengthFL FocusList a
fl) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
appendFL :: FocusList a -> a -> FocusList a
appendFL :: FocusList a -> a -> FocusList a
appendFL FocusList a
fl a
a =
if FocusList a -> Bool
forall a. FocusList a -> Bool
isEmptyFL FocusList a
fl
then a -> FocusList a
forall a. a -> FocusList a
singletonFL a
a
else Int -> a -> FocusList a -> FocusList a
forall a. Int -> a -> FocusList a -> FocusList a
insertFL (Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Seq a -> Int) -> Seq a -> Int
forall a b. (a -> b) -> a -> b
$ FocusList a -> Seq a
forall a. FocusList a -> Seq a
focusList FocusList a
fl) a
a FocusList a
fl
appendSetFocusFL :: FocusList a -> a -> FocusList a
appendSetFocusFL :: FocusList a -> a -> FocusList a
appendSetFocusFL FocusList a
fl a
a =
let oldLen :: Int
oldLen = Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Seq a -> Int) -> Seq a -> Int
forall a b. (a -> b) -> a -> b
$ FocusList a -> Seq a
forall a. FocusList a -> Seq a
focusList FocusList a
fl
in
case Int -> FocusList a -> Maybe (FocusList a)
forall a. Int -> FocusList a -> Maybe (FocusList a)
setFocusFL Int
oldLen (FocusList a -> a -> FocusList a
forall a. FocusList a -> a -> FocusList a
appendFL FocusList a
fl a
a) of
Maybe (FocusList a)
Nothing -> String -> FocusList a
forall a. HasCallStack => String -> a
error String
"Internal error with setting the focus. This should never happen."
Just FocusList a
newFL -> FocusList a
newFL
prependFL :: a -> FocusList a -> FocusList a
prependFL :: a -> FocusList a -> FocusList a
prependFL a
a fl :: FocusList a
fl@FocusList{ focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus
focus, focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls} =
case Focus
focus of
Focus
NoFocus -> a -> FocusList a
forall a. a -> FocusList a
singletonFL a
a
Focus Int
i ->
FocusList a
fl
{ focusListFocus :: Focus
focusListFocus = Int -> Focus
Focus (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)
, focusList :: Seq a
focusList = a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
<| Seq a
fls
}
unsafeGetFocusFL :: FocusList a -> Int
unsafeGetFocusFL :: FocusList a -> Int
unsafeGetFocusFL FocusList a
fl =
let focus :: Focus
focus = FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus
in
case Focus
focus of
Focus
NoFocus -> String -> Int
forall a. HasCallStack => String -> a
error String
"unsafeGetFocusFL: the focus list doesn't have a focus"
Focus Int
i -> Int
i
hasFocusFL :: FocusList a -> Bool
hasFocusFL :: FocusList a -> Bool
hasFocusFL = Focus -> Bool
hasFocus (Focus -> Bool) -> (FocusList a -> Focus) -> FocusList a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FocusList a -> Focus
forall a. FocusList a -> Focus
getFocusFL
getFocusFL :: FocusList a -> Focus
getFocusFL :: FocusList a -> Focus
getFocusFL FocusList{Focus
focusListFocus :: Focus
focusListFocus :: forall a. FocusList a -> Focus
focusListFocus} = Focus
focusListFocus
unsafeGetFocusItemFL :: FocusList a -> a
unsafeGetFocusItemFL :: FocusList a -> a
unsafeGetFocusItemFL FocusList a
fl =
let focus :: Focus
focus = FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus
in
case Focus
focus of
Focus
NoFocus -> String -> a
forall a. HasCallStack => String -> a
error String
"unsafeGetFocusItemFL: the focus list doesn't have a focus"
Focus Int
i ->
let fls :: Seq a
fls = FocusList a
fl FocusList a -> Getting (Seq a) (FocusList a) (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) (FocusList a) (Seq a)
forall a a. Lens (FocusList a) (FocusList a) (Seq a) (Seq a)
lensFocusList
in
case Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Sequence.lookup Int
i Seq a
fls of
Maybe a
Nothing ->
String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$
String
"unsafeGetFocusItemFL: internal error, i (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
") doesnt exist in sequence"
Just a
a -> a
a
getFocusItemFL :: FocusList a -> Maybe a
getFocusItemFL :: FocusList a -> Maybe a
getFocusItemFL FocusList a
fl =
let focus :: Focus
focus = FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus
in
case Focus
focus of
Focus
NoFocus -> Maybe a
forall a. Maybe a
Nothing
Focus Int
i ->
let fls :: Seq a
fls = FocusList a
fl FocusList a -> Getting (Seq a) (FocusList a) (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) (FocusList a) (Seq a)
forall a a. Lens (FocusList a) (FocusList a) (Seq a) (Seq a)
lensFocusList
in
case Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Sequence.lookup Int
i Seq a
fls of
Maybe a
Nothing ->
String -> Maybe a
forall a. HasCallStack => String -> a
error (String -> Maybe a) -> String -> Maybe a
forall a b. (a -> b) -> a -> b
$
String
"getFocusItemFL: internal error, i (" String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
Int -> String
forall a. Show a => a -> String
show Int
i String -> ShowS
forall a. Semigroup a => a -> a -> a
<>
String
") doesnt exist in sequence"
Just a
a -> a -> Maybe a
forall a. a -> Maybe a
Just a
a
setFocusItemFL :: a -> FocusList a -> FocusList a
setFocusItemFL :: a -> FocusList a -> FocusList a
setFocusItemFL a
a FocusList a
fl = (a -> a) -> FocusList a -> FocusList a
forall a. (a -> a) -> FocusList a -> FocusList a
updateFocusItemFL (a -> a -> a
forall a b. a -> b -> a
const a
a) FocusList a
fl
updateFocusItemFL :: (a -> a) -> FocusList a -> FocusList a
updateFocusItemFL :: (a -> a) -> FocusList a -> FocusList a
updateFocusItemFL a -> a
f FocusList a
fl =
let focus :: Focus
focus = FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus
in
case Focus
focus of
Focus
NoFocus -> FocusList a
fl
Focus Int
i ->
let fls :: Seq a
fls = FocusList a
fl FocusList a -> Getting (Seq a) (FocusList a) (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) (FocusList a) (Seq a)
forall a a. Lens (FocusList a) (FocusList a) (Seq a) (Seq a)
lensFocusList
in FocusList a
fl { focusList :: Seq a
focusList = (a -> a) -> Int -> Seq a -> Seq a
forall a. (a -> a) -> Int -> Seq a -> Seq a
Sequence.adjust' a -> a
f Int
i Seq a
fls }
lookupFL
:: Int
-> FocusList a
-> Maybe a
lookupFL :: Int -> FocusList a -> Maybe a
lookupFL Int
i FocusList a
fl = Int -> Seq a -> Maybe a
forall a. Int -> Seq a -> Maybe a
Sequence.lookup Int
i (FocusList a
fl FocusList a -> Getting (Seq a) (FocusList a) (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) (FocusList a) (Seq a)
forall a a. Lens (FocusList a) (FocusList a) (Seq a) (Seq a)
lensFocusList)
insertFL
:: Int
-> a
-> FocusList a
-> FocusList a
insertFL :: Int -> a -> FocusList a -> FocusList a
insertFL Int
_ a
a FocusList {focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus
NoFocus} = a -> FocusList a
forall a. a -> FocusList a
singletonFL a
a
insertFL Int
i a
a fl :: FocusList a
fl@FocusList{focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus Int
focus, focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls} =
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
focus
then
FocusList a
fl
{ focusList :: Seq a
focusList = Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
insertAt Int
i a
a Seq a
fls
}
else
FocusList a
fl
{ focusList :: Seq a
focusList = Int -> a -> Seq a -> Seq a
forall a. Int -> a -> Seq a -> Seq a
insertAt Int
i a
a Seq a
fls
, focusListFocus :: Focus
focusListFocus = Int -> Focus
Focus (Int -> Focus) -> Int -> Focus
forall a b. (a -> b) -> a -> b
$ Int
focus Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
}
removeFL
:: Int
-> FocusList a
-> Maybe (FocusList a)
removeFL :: Int -> FocusList a -> Maybe (FocusList a)
removeFL Int
i fl :: FocusList a
fl@FocusList{focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls}
| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= (FocusList a -> Int
forall a. FocusList a -> Int
lengthFL FocusList a
fl) Bool -> Bool -> Bool
|| FocusList a -> Bool
forall a. FocusList a -> Bool
isEmptyFL FocusList a
fl =
Maybe (FocusList a)
forall a. Maybe a
Nothing
| FocusList a -> Int
forall a. FocusList a -> Int
lengthFL FocusList a
fl Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 =
FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just FocusList a
forall a. FocusList a
emptyFL
| Bool
otherwise =
let newFL :: FocusList a
newFL = FocusList a
fl {focusList :: Seq a
focusList = Int -> Seq a -> Seq a
forall a. Int -> Seq a -> Seq a
deleteAt Int
i Seq a
fls}
focus :: Int
focus = FocusList a -> Int
forall a. FocusList a -> Int
unsafeGetFocusFL FocusList a
fl
in
if Int
focus Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i Bool -> Bool -> Bool
&& Int
focus Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
then FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just (FocusList a -> Maybe (FocusList a))
-> FocusList a -> Maybe (FocusList a)
forall a b. (a -> b) -> a -> b
$ FocusList a
newFL FocusList a -> (FocusList a -> FocusList a) -> FocusList a
forall a b. a -> (a -> b) -> b
& (Focus -> Identity Focus) -> FocusList a -> Identity (FocusList a)
forall a. Lens' (FocusList a) Focus
lensFocusListFocus ((Focus -> Identity Focus)
-> FocusList a -> Identity (FocusList a))
-> ((Int -> Identity Int) -> Focus -> Identity Focus)
-> (Int -> Identity Int)
-> FocusList a
-> Identity (FocusList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Focus -> Identity Focus
Prism Focus Focus Int Int
_Focus ((Int -> Identity Int) -> FocusList a -> Identity (FocusList a))
-> Int -> FocusList a -> FocusList a
forall a s t. Num a => ASetter s t a a -> a -> s -> t
-~ Int
1
else FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just FocusList a
newFL
indexOfFL :: Eq a => a -> FocusList a -> Maybe Int
indexOfFL :: a -> FocusList a -> Maybe Int
indexOfFL a
a FocusList{focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls} =
a -> Seq a -> Maybe Int
forall a. Eq a => a -> Seq a -> Maybe Int
elemIndexL a
a Seq a
fls
deleteFL
:: forall a.
(Eq a)
=> a
-> FocusList a
-> FocusList a
deleteFL :: a -> FocusList a -> FocusList a
deleteFL a
item = FocusList a -> FocusList a
go
where
go :: FocusList a -> FocusList a
go :: FocusList a -> FocusList a
go FocusList a
fl =
let maybeIndex :: Maybe Int
maybeIndex = a -> FocusList a -> Maybe Int
forall a. Eq a => a -> FocusList a -> Maybe Int
indexOfFL a
item FocusList a
fl
in
case Maybe Int
maybeIndex of
Maybe Int
Nothing -> FocusList a
fl
Just Int
i ->
let maybeNewFL :: Maybe (FocusList a)
maybeNewFL = Int -> FocusList a -> Maybe (FocusList a)
forall a. Int -> FocusList a -> Maybe (FocusList a)
removeFL Int
i FocusList a
fl
in
case Maybe (FocusList a)
maybeNewFL of
Maybe (FocusList a)
Nothing -> FocusList a
fl
Just FocusList a
newFL -> FocusList a -> FocusList a
go FocusList a
newFL
setFocusFL :: Int -> FocusList a -> Maybe (FocusList a)
setFocusFL :: Int -> FocusList a -> Maybe (FocusList a)
setFocusFL Int
i FocusList a
fl
| FocusList a -> Bool
forall a. FocusList a -> Bool
isEmptyFL FocusList a
fl = Maybe (FocusList a)
forall a. Maybe a
Nothing
| Bool
otherwise =
let len :: Int
len = FocusList a -> Int
forall a. FocusList a -> Int
lengthFL FocusList a
fl
in
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
then Maybe (FocusList a)
forall a. Maybe a
Nothing
else FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just (FocusList a -> Maybe (FocusList a))
-> FocusList a -> Maybe (FocusList a)
forall a b. (a -> b) -> a -> b
$ FocusList a
fl FocusList a -> (FocusList a -> FocusList a) -> FocusList a
forall a b. a -> (a -> b) -> b
& (Focus -> Identity Focus) -> FocusList a -> Identity (FocusList a)
forall a. Lens' (FocusList a) Focus
lensFocusListFocus ((Focus -> Identity Focus)
-> FocusList a -> Identity (FocusList a))
-> ((Int -> Identity Int) -> Focus -> Identity Focus)
-> (Int -> Identity Int)
-> FocusList a
-> Identity (FocusList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Focus -> Identity Focus
Prism Focus Focus Int Int
_Focus ((Int -> Identity Int) -> FocusList a -> Identity (FocusList a))
-> Int -> FocusList a -> FocusList a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
i
updateFocusFL
:: Int
-> FocusList a
-> Maybe (a, FocusList a)
updateFocusFL :: Int -> FocusList a -> Maybe (a, FocusList a)
updateFocusFL Int
i FocusList a
fl
| FocusList a -> Bool
forall a. FocusList a -> Bool
isEmptyFL FocusList a
fl = Maybe (a, FocusList a)
forall a. Maybe a
Nothing
| Bool
otherwise =
let len :: Int
len = FocusList a -> Int
forall a. FocusList a -> Int
lengthFL FocusList a
fl
in
if Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
len
then Maybe (a, FocusList a)
forall a. Maybe a
Nothing
else
let newFL :: FocusList a
newFL = FocusList a
fl FocusList a -> (FocusList a -> FocusList a) -> FocusList a
forall a b. a -> (a -> b) -> b
& (Focus -> Identity Focus) -> FocusList a -> Identity (FocusList a)
forall a. Lens' (FocusList a) Focus
lensFocusListFocus ((Focus -> Identity Focus)
-> FocusList a -> Identity (FocusList a))
-> ((Int -> Identity Int) -> Focus -> Identity Focus)
-> (Int -> Identity Int)
-> FocusList a
-> Identity (FocusList a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Identity Int) -> Focus -> Identity Focus
Prism Focus Focus Int Int
_Focus ((Int -> Identity Int) -> FocusList a -> Identity (FocusList a))
-> Int -> FocusList a -> FocusList a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int
i
in (a, FocusList a) -> Maybe (a, FocusList a)
forall a. a -> Maybe a
Just (FocusList a -> a
forall a. FocusList a -> a
unsafeGetFocusItemFL FocusList a
newFL, FocusList a
newFL)
findFL :: (a -> Bool) -> FocusList a -> Maybe (a)
findFL :: (a -> Bool) -> FocusList a -> Maybe a
findFL a -> Bool
p FocusList a
fl =
let fls :: Seq a
fls = FocusList a
fl FocusList a -> Getting (Seq a) (FocusList a) (Seq a) -> Seq a
forall s a. s -> Getting a s a -> a
^. Getting (Seq a) (FocusList a) (Seq a)
forall a a. Lens (FocusList a) (FocusList a) (Seq a) (Seq a)
lensFocusList
in (Element (Seq a) -> Bool) -> Seq a -> Maybe (Element (Seq a))
forall seq.
SemiSequence seq =>
(Element seq -> Bool) -> seq -> Maybe (Element seq)
find a -> Bool
Element (Seq a) -> Bool
p Seq a
fls
moveFromToFL
:: Show a
=> Int
-> Int
-> FocusList a
-> Maybe (FocusList a)
moveFromToFL :: Int -> Int -> FocusList a -> Maybe (FocusList a)
moveFromToFL Int
oldPos Int
newPos FocusList a
fl
| Int
oldPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
oldPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= FocusList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FocusList a
fl = Maybe (FocusList a)
forall a. Maybe a
Nothing
| Int
newPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 Bool -> Bool -> Bool
|| Int
newPos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= FocusList a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FocusList a
fl = Maybe (FocusList a)
forall a. Maybe a
Nothing
| Bool
otherwise =
let oldFocus :: Focus
oldFocus = FocusList a
fl FocusList a -> Getting Focus (FocusList a) Focus -> Focus
forall s a. s -> Getting a s a -> a
^. Getting Focus (FocusList a) Focus
forall a. Lens' (FocusList a) Focus
lensFocusListFocus
in
case Int -> FocusList a -> Maybe a
forall a. Int -> FocusList a -> Maybe a
lookupFL Int
oldPos FocusList a
fl of
Maybe a
Nothing -> String -> Maybe (FocusList a)
forall a. HasCallStack => String -> a
error String
"moveFromToFL should have been able to lookup the item"
Just a
item ->
case Int -> FocusList a -> Maybe (FocusList a)
forall a. Int -> FocusList a -> Maybe (FocusList a)
removeFL Int
oldPos FocusList a
fl of
Maybe (FocusList a)
Nothing -> String -> Maybe (FocusList a)
forall a. HasCallStack => String -> a
error String
"moveFromToFL should have been able to remove old position"
Just FocusList a
flAfterRemove ->
let flAfterInsert :: FocusList a
flAfterInsert = Int -> a -> FocusList a -> FocusList a
forall a. Int -> a -> FocusList a -> FocusList a
insertFL Int
newPos a
item FocusList a
flAfterRemove in
if Int -> Focus
Focus Int
oldPos Focus -> Focus -> Bool
forall a. Eq a => a -> a -> Bool
== Focus
oldFocus
then
case Int -> FocusList a -> Maybe (FocusList a)
forall a. Int -> FocusList a -> Maybe (FocusList a)
setFocusFL Int
newPos FocusList a
flAfterInsert of
Maybe (FocusList a)
Nothing -> String -> Maybe (FocusList a)
forall a. HasCallStack => String -> a
error String
"moveFromToFL should have been able to reset the focus"
Just FocusList a
flWithUpdatedFocus -> FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just FocusList a
flWithUpdatedFocus
else FocusList a -> Maybe (FocusList a)
forall a. a -> Maybe a
Just FocusList a
flAfterInsert
intersperseFL :: a -> FocusList a -> FocusList a
intersperseFL :: a -> FocusList a -> FocusList a
intersperseFL a
_ FocusList{focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus
NoFocus} = FocusList a
forall a. FocusList a
emptyFL
intersperseFL a
a FocusList{focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls, focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus Int
foc} =
let newFLS :: Seq a
newFLS = Element (Seq a) -> Seq a -> Seq a
forall seq. SemiSequence seq => Element seq -> seq -> seq
intersperse a
Element (Seq a)
a Seq a
fls
in
FocusList :: forall a. Focus -> Seq a -> FocusList a
FocusList
{ focusList :: Seq a
focusList = Seq a
newFLS
, focusListFocus :: Focus
focusListFocus = Int -> Focus
Focus (Int
foc Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2)
}
reverseFL :: FocusList a -> FocusList a
reverseFL :: FocusList a -> FocusList a
reverseFL FocusList{focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus
NoFocus} = FocusList a
forall a. FocusList a
emptyFL
reverseFL FocusList{focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls, focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus Int
foc} =
let newFLS :: Seq a
newFLS = Seq a -> Seq a
forall seq. SemiSequence seq => seq -> seq
reverse Seq a
fls
newFLSLen :: Int
newFLSLen = Seq a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Seq a
newFLS
in
FocusList :: forall a. Focus -> Seq a -> FocusList a
FocusList
{ focusList :: Seq a
focusList = Seq a
newFLS
, focusListFocus :: Focus
focusListFocus = Int -> Focus
Focus (Int
newFLSLen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
foc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)
}
sortByFL
:: forall a
. (a -> a -> Ordering)
-> FocusList a
-> FocusList a
sortByFL :: (a -> a -> Ordering) -> FocusList a -> FocusList a
sortByFL a -> a -> Ordering
_ FocusList{focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus
NoFocus} = FocusList a
forall a. FocusList a
emptyFL
sortByFL a -> a -> Ordering
cmpFunc FocusList{focusList :: forall a. FocusList a -> Seq a
focusList = Seq a
fls, focusListFocus :: forall a. FocusList a -> Focus
focusListFocus = Focus Int
foc} =
let (Seq a
res, Maybe Int
maybeNewFoc) = Seq a -> Maybe Int -> (Seq a, Maybe Int)
go Seq a
fls (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
foc)
in
case Maybe Int
maybeNewFoc of
Maybe Int
Nothing -> String -> FocusList a
forall a. HasCallStack => String -> a
error String
"sortByFL: A sequence should never lose its focus."
Just Int
newFoc ->
FocusList :: forall a. Focus -> Seq a -> FocusList a
FocusList
{ focusList :: Seq a
focusList = Seq a
res
, focusListFocus :: Focus
focusListFocus = Int -> Focus
Focus Int
newFoc
}
where
go
:: Seq a
-> Maybe Int
-> (Seq a, Maybe Int)
go :: Seq a -> Maybe Int -> (Seq a, Maybe Int)
go Seq a
Empty (Just Int
_) =
String -> (Seq a, Maybe Int)
forall a. HasCallStack => String -> a
error String
"sortByFL: go: this should never happen, sort empty with focus."
go Seq a
Empty Maybe Int
Nothing = (Seq a
forall a. Seq a
Empty, Maybe Int
forall a. Maybe a
Nothing)
go (a
a :<| Seq a
as) Maybe Int
Nothing =
let res :: (Seq a, Maybe Int)
res = Seq a -> Maybe Int -> (Seq a, Maybe Int)
go Seq a
as Maybe Int
forall a. Maybe a
Nothing
in
case (Seq a, Maybe Int)
res of
(Seq a
_, Just Int
_) -> String -> (Seq a, Maybe Int)
forall a. HasCallStack => String -> a
error String
"sortByFL: go: this should never happen, no focus case"
(Seq a
Empty, Maybe Int
Nothing) -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
forall a. Seq a
Empty, Maybe Int
forall a. Maybe a
Nothing)
(a
b :<| Seq a
bs, Maybe Int
Nothing) ->
case a -> a -> Ordering
cmpFunc a
a a
b of
Ordering
LT -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs, Maybe Int
forall a. Maybe a
Nothing)
Ordering
EQ -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs, Maybe Int
forall a. Maybe a
Nothing)
Ordering
GT -> (a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| (Seq a, Maybe Int) -> Seq a
forall a b. (a, b) -> a
fst (Seq a -> Maybe Int -> (Seq a, Maybe Int)
go (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs) Maybe Int
forall a. Maybe a
Nothing), Maybe Int
forall a. Maybe a
Nothing)
go (a
a :<| Seq a
as) (Just Int
0) =
let res :: (Seq a, Maybe Int)
res = Seq a -> Maybe Int -> (Seq a, Maybe Int)
go Seq a
as Maybe Int
forall a. Maybe a
Nothing
in
case (Seq a, Maybe Int)
res of
(Seq a
_, Just Int
_) -> String -> (Seq a, Maybe Int)
forall a. HasCallStack => String -> a
error String
"sortByFL: go: this should never happen, top elem has focus case"
(Seq a
Empty, Maybe Int
Nothing) -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
forall a. Seq a
Empty, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
(a
b :<| Seq a
bs, Maybe Int
Nothing) ->
case a -> a -> Ordering
cmpFunc a
a a
b of
Ordering
LT -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
Ordering
EQ -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs, Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
Ordering
GT ->
let (Seq a
newSeq, Maybe Int
maybeNewFoc) = Seq a -> Maybe Int -> (Seq a, Maybe Int)
go (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
in
case Maybe Int
maybeNewFoc of
Maybe Int
Nothing -> String -> (Seq a, Maybe Int)
forall a. HasCallStack => String -> a
error String
"sortByFL: go: this should never happen, lost the focus"
Just Int
newFoc -> (a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
newSeq, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
newFoc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
go (a
a :<| Seq a
as) (Just Int
n) =
let res :: (Seq a, Maybe Int)
res = Seq a -> Maybe Int -> (Seq a, Maybe Int)
go Seq a
as (Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
in
case (Seq a, Maybe Int)
res of
(Seq a
_, Maybe Int
Nothing) -> String -> (Seq a, Maybe Int)
forall a. HasCallStack => String -> a
error String
"sortByFL: go: this should never happen, no focus"
(Seq a
Empty, Just Int
_) -> String -> (Seq a, Maybe Int)
forall a. HasCallStack => String -> a
error String
"sortByFL: go: this should never happen, focus but no elems"
(a
b :<| Seq a
bs, Just Int
newFoc) ->
case a -> a -> Ordering
cmpFunc a
a a
b of
Ordering
LT -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
newFoc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Ordering
EQ -> (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
newFoc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
Ordering
GT ->
case Int
newFoc of
Int
0 -> (a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| (Seq a, Maybe Int) -> Seq a
forall a b. (a, b) -> a
fst (Seq a -> Maybe Int -> (Seq a, Maybe Int)
go (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs) Maybe Int
forall a. Maybe a
Nothing), Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0)
Int
gt0 ->
let (Seq a
newSeq, Maybe Int
maybeNewFoc') = Seq a -> Maybe Int -> (Seq a, Maybe Int)
go (a
a a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
bs) (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
gt0)
in
case Maybe Int
maybeNewFoc' of
Maybe Int
Nothing -> String -> (Seq a, Maybe Int)
forall a. HasCallStack => String -> a
error String
"sortByFL: go: this should never happen, lost the focus again"
Just Int
newFoc' -> (a
b a -> Seq a -> Seq a
forall a. a -> Seq a -> Seq a
:<| Seq a
newSeq, Int -> Maybe Int
forall a. a -> Maybe a
Just (Int
newFoc' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))