{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Data.FocusList
  (
    -- * FocusList
    FocusList(FocusList, focusListFocus, focusList)
    -- ** Conversions
  , fromListFL
  , fromFoldableFL
  , toSeqFL
    -- ** Query
  , lengthFL
  , isEmptyFL
  , getFocusItemFL
  , lookupFL
  , indexOfFL
  , findFL
    -- *** Query 'Focus'
  , hasFocusFL
  , getFocusFL
    -- ** Manipulate
  , prependFL
  , appendFL
  , appendSetFocusFL
  , insertFL
  , removeFL
  , deleteFL
  , moveFromToFL
  , intersperseFL
  , reverseFL
  , updateFocusItemFL
  , setFocusItemFL
  , -- *** Optics
    traversalFocusItem
    -- *** Manipulate 'Focus'
  , setFocusFL
  , updateFocusFL
    -- ** Sort
  , sortByFL
    -- ** Construction
  , emptyFL
  , singletonFL
    -- ** Unsafe Functions
  , unsafeFromListFL
  , unsafeGetFocusFL
  , unsafeGetFocusItemFL
    -- ** Invariants
  , invariantFL
    -- ** Testing
  , genValidFL
    -- ** Optics
    -- | These optics allow you to get/set the internal state of a 'FocusList'.
    -- You should make sure not to directly set the internal state of a
    -- 'FocusList' unless you are sure that the invariants for the 'FocusList'
    -- are protected.  See 'invariantFL'.
  , lensFocusListFocus
  , lensFocusList
    -- * Focus
  , Focus(Focus, NoFocus)
  , hasFocus
  , getFocus
  , maybeToFocus
  , foldFocus
    -- ** Optics
  , _Focus
  , _NoFocus
    -- ** Unsafe Functions
  , 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
  )

-- $setup
-- >>> :set -XFlexibleContexts
-- >>> :set -XScopedTypeVariables
-- >>> import Data.Maybe (isJust)
-- >>> import Control.Lens ((^..))

-- | A 'Focus' for the 'FocusList'.
--
-- The 'Focus' is either 'NoFocus' (if the 'Focuslist' is empty), or 'Focus'
-- 'Int' to represent focusing on a specific element of the 'FocusList'.
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)

-- | 'NoFocus' is always less than 'Focus'.
--
-- prop> NoFocus < Focus a
--
-- The ordering of 'Focus' depends on the ordering of the integer contained
-- inside.
--
-- prop> (a < b) ==> (Focus a < Focus b)
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)]

-- | A fold function for 'Focus'.
--
-- This is similar to 'maybe' for 'Maybe'.
--
-- >>> foldFocus "empty" (\i -> "focus at " <> show i) (Focus 3)
-- "focus at 3"
--
-- >>> foldFocus Nothing Just NoFocus
-- Nothing
--
-- prop> foldFocus NoFocus Focus focus == focus
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

-- | A 'Prism'' for focusing on the 'Focus' constructor in a 'Focus' data type.
--
-- You can use this to get the 'Int' that is being focused on:
--
-- >>> import Control.Lens ((^?))
-- >>> Focus 100 ^? _Focus
-- Just 100
-- >>> NoFocus ^? _Focus
-- Nothing
_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)

-- | A 'Prism'' for focusing on the 'NoFocus' constructor in a 'Focus' data type.
--
-- >>> import Control.Lens.Extras (is)
-- >>> is _NoFocus NoFocus
-- True
-- >>> is _NoFocus (Focus 3)
-- False
_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))

-- | Returns 'True' if a 'Focus' exists, and 'False' if not.
--
-- >>> hasFocus (Focus 0)
-- True
--
-- >>> hasFocus NoFocus
-- False
--
-- /complexity/: @O(1)@
hasFocus :: Focus -> Bool
hasFocus :: Focus -> Bool
hasFocus Focus
NoFocus = Bool
False
hasFocus (Focus Int
_) = Bool
True

-- | Get the focus index from a 'Focus'.
--
-- >>> getFocus (Focus 3)
-- Just 3
--
-- >>> getFocus NoFocus
-- Nothing
--
-- /complexity/: @O(1)@
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

-- | Convert a 'Maybe' 'Int' to a 'Focus'.
--
-- >>> maybeToFocus (Just 100)
-- Focus 100
--
-- >>> maybeToFocus Nothing
-- NoFocus
--
-- 'maybeToFocus' and 'getFocus' witness an isomorphism.
--
-- prop> focus == maybeToFocus (getFocus focus)
--
-- prop> maybeInt == getFocus (maybeToFocus maybeInt)
--
-- /complexity/: @O(1)@
maybeToFocus :: Maybe Int -> Focus
maybeToFocus :: Maybe Int -> Focus
maybeToFocus Maybe Int
Nothing = Focus
NoFocus
maybeToFocus (Just Int
i) = Int -> Focus
Focus Int
i

-- | Unsafely get the focus index from a 'Focus'.
--
-- Returns an error if 'NoFocus'.
--
-- >>> unsafeGetFocus (Focus 50)
-- 50
--
-- >>> unsafeGetFocus NoFocus
-- *** Exception: ...
-- ...
--
-- /complexity/: @O(1)@
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

-- | A list with a given element having the 'Focus'.
--
-- 'FocusList' has some invariants that must be protected.  You should not use
-- the 'FocusList' constructor or the 'focusListFocus' or 'focusList'
-- accessors.
--
-- Implemented under the hood as a 'Seq'.
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
 )

-- | A 'Traversal' for the focused item in a 'FocusList'.
--
-- This can be used to get the focused item:
--
-- >>> import Control.Lens ((^?))
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"]
-- >>> fl ^? traversalFocusItem
-- Just "bye"
-- >>> emptyFL ^? traversalFocusItem
-- Nothing
--
-- This can also be used to set the focused item:
--
-- >>> import Control.Lens (set)
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"]
-- >>> set traversalFocusItem "new val" fl
-- FocusList (Focus 1) ["hello","new val","tree"]
-- >>> set traversalFocusItem "new val" emptyFL
-- FocusList NoFocus []
--
-- Note that this traversal will apply to no elements if the 'FocusList' is
-- empty and 'NoFocus'.  This traversal will apply to a single element if the
-- 'FocusList' has a 'Focus'.  This makes 'traversalFocusItem' an affine traversal.
--
-- prop> length (fl ^.. traversalFocusItem) <= 1
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

-- | Given a 'Gen' for @a@, generate a valid 'FocusList'.
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)

-- | Get the underlying 'Seq' in a 'FocusList'.
--
-- /complexity/: @O(1)@
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

-- | Return the length of a 'FocusList'.
--
-- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"]
-- >>> lengthFL fl
-- 3
--
-- /complexity/: @O(1)@
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

-- | This is an invariant that the 'FocusList' must always protect.
--
-- The functions in this module should generally protect this invariant.  If
-- they do not, it is generally a bug.
--
-- The invariants are as follows:
--
-- - The 'Focus' in a 'FocusList' can never be negative.
--
-- - If there is a 'Focus', then it actually exists in
--   the 'FocusList'.
--
-- - There needs to be a 'Focus' if the length of the
--   'FocusList' is greater than 0.
--
-- /complexity/: @O(log n)@, where @n@ is the length of the '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
    -- This makes sure that the 'Focus' in a 'FocusList' can never be negative.
    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

    -- | This makes sure that if there is a 'Focus', then it actually exists in
    -- the 'FocusList'.
    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

    -- | This makes sure that there needs to be a 'Focus' if the length of the
    -- 'FocusList' is greater than 0.
    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

-- | Unsafely create a 'FocusList'.  This does not check that the focus
-- actually exists in the list.  This is an internal function and should
-- generally not be used.  It is only safe to use if you ALREADY know
-- the 'Focus' is within the list.
--
-- Instead, you should generally use 'fromListFL'.
--
-- The following is an example of using 'unsafeFromListFL' correctly.
--
-- >>> unsafeFromListFL (Focus 1) [0..2]
-- FocusList (Focus 1) [0,1,2]
--
-- >>> unsafeFromListFL NoFocus []
-- FocusList NoFocus []
--
-- 'unsafeFromListFL' can also be used uncorrectly.  The following is an
-- example of 'unsafeFromListFL' allowing you to create a 'FocusList' that does
-- not pass 'invariantFL'.
--
-- >>> unsafeFromListFL (Focus 100) [0..2]
-- FocusList (Focus 100) [0,1,2]
--
-- If 'fromListFL' returns a 'Just' 'FocusList', then 'unsafeFromListFL' should
-- return the same 'FocusList'.
--
-- /complexity/: @O(n)@ where @n@ is the length of the input list.
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
    }

-- | Safely create a 'FocusList' from a list.
--
-- >>> fromListFL (Focus 1) ["cat","dog","goat"]
-- Just (FocusList (Focus 1) ["cat","dog","goat"])
--
-- >>> fromListFL NoFocus []
-- Just (FocusList NoFocus [])
--
-- If the 'Focus' is out of range for the list, then 'Nothing' will be returned.
--
-- >>> fromListFL (Focus (-1)) ["cat","dog","goat"]
-- Nothing
--
-- >>> fromListFL (Focus 3) ["cat","dog","goat"]
-- Nothing
--
-- >>> fromListFL NoFocus ["cat","dog","goat"]
-- Nothing
--
-- /complexity/: @O(n)@ where @n@ is the length of the input 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
          }

-- | Create a 'FocusList' from any 'Foldable' container.
--
-- This just calls 'toList' on the 'Foldable', and then passes the result to
-- 'fromListFL'.
--
-- prop> fromFoldableFL foc (foldable :: Data.Sequence.Seq Int) == fromListFL foc (toList foldable)
--
-- /complexity/: @O(n)@ where @n@ is the length of the 'Foldable'
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)

-- | Create a 'FocusList' with a single element.
--
-- >>> singletonFL "hello"
-- FocusList (Focus 0) ["hello"]
--
-- /complexity/: @O(1)@
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
    }

-- | Create an empty 'FocusList' without a 'Focus'.
--
-- >>> emptyFL
-- FocusList NoFocus []
--
-- /complexity/: @O(1)@
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
    }

-- | Return 'True' if the 'FocusList' is empty.
--
-- >>> isEmptyFL emptyFL
-- True
--
-- >>> isEmptyFL $ singletonFL "hello"
-- False
--
-- Any 'FocusList' with a 'Focus' should never be empty.
--
-- prop> hasFocusFL fl ==> not (isEmptyFL fl)
--
-- The opposite is also true.
--
-- /complexity/: @O(1)@
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

-- | Append a value to the end of a 'FocusList'.
--
-- This can be thought of as a \"snoc\" operation.
--
-- >>> appendFL emptyFL "hello"
-- FocusList (Focus 0) ["hello"]
--
-- >>> appendFL (singletonFL "hello") "bye"
-- FocusList (Focus 0) ["hello","bye"]
--
-- Appending a value to an empty 'FocusList' is the same as using 'singletonFL'.
--
-- prop> appendFL emptyFL a == singletonFL a
--
-- /complexity/: @O(log n)@ where @n@ is the length of the 'FocusList'.
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

-- | A combination of 'appendFL' and 'setFocusFL'.
--
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"]
-- >>> appendSetFocusFL fl "pie"
-- FocusList (Focus 3) ["hello","bye","tree","pie"]
--
-- The 'Focus' will always be updated after calling 'appendSetFocusFL'.
--
-- prop> getFocusFL (appendSetFocusFL fl a) > getFocusFL fl
--
-- /complexity/: @O(log n)@ where @n@ is the length of the 'FocusList'.
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

-- | Prepend a value to a 'FocusList'.
--
-- This can be thought of as a \"cons\" operation.
--
-- >>> prependFL "hello" emptyFL
-- FocusList (Focus 0) ["hello"]
--
-- The focus will be updated when prepending:
--
-- >>> prependFL "bye" (singletonFL "hello")
-- FocusList (Focus 1) ["bye","hello"]
--
-- Prepending to a 'FocusList' will always update the 'Focus':
--
-- prop> getFocusFL fl < getFocusFL (prependFL a fl)
--
-- /complexity/: @O(1)@
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
        }

-- | Unsafely get the 'Focus' from a 'FocusList'.  If the 'Focus' is
-- 'NoFocus', this function returns 'error'.
--
-- This function is only safe if you already have knowledge that
-- the 'FocusList' has a 'Focus'.
--
-- Generally, 'getFocusFL' should be used instead of this function.
--
-- >>> let Just fl = fromListFL (Focus 1) [0..9]
-- >>> unsafeGetFocusFL fl
-- 1
--
-- >>> unsafeGetFocusFL emptyFL
-- *** Exception: ...
-- ...
--
-- /complexity/: @O(1)@
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

-- | Return 'True' if the 'Focus' in a 'FocusList' exists.
--
-- Return 'False' if the 'Focus' in a 'FocusList' is 'NoFocus'.
--
-- >>> hasFocusFL $ singletonFL "hello"
-- True
--
-- >>> hasFocusFL emptyFL
-- False
--
-- /complexity/: @O(1)@
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

-- | Get the 'Focus' from a 'FocusList'.
--
-- >>> getFocusFL $ singletonFL "hello"
-- Focus 0
--
-- >>> let Just fl = fromListFL (Focus 3) [0..9]
-- >>> getFocusFL fl
-- Focus 3
--
-- >>> getFocusFL emptyFL
-- NoFocus
--
-- /complexity/: @O(1)@
getFocusFL :: FocusList a -> Focus
getFocusFL :: FocusList a -> Focus
getFocusFL FocusList{Focus
focusListFocus :: Focus
focusListFocus :: forall a. FocusList a -> Focus
focusListFocus} = Focus
focusListFocus

-- | Unsafely get the value of the 'Focus' from a 'FocusList'.  If the 'Focus' is
-- 'NoFocus', this function returns 'error'.
--
-- This function is only safe if you already have knowledge that the 'FocusList'
-- has a 'Focus'.
--
-- Generally, 'getFocusItemFL' should be used instead of this function.
--
-- >>> let Just fl = fromListFL (Focus 0) ['a'..'c']
-- >>> unsafeGetFocusItemFL fl
-- 'a'
--
-- >>> unsafeGetFocusFL emptyFL
-- *** Exception: ...
-- ...
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@
-- is the length of the 'FocusList'.
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

-- | Get the item the 'FocusList' is focusing on.  Return 'Nothing' if the
-- 'FocusList' is empty.
--
-- >>> let Just fl = fromListFL (Focus 0) ['a'..'c']
-- >>> getFocusItemFL fl
-- Just 'a'
--
-- >>> getFocusItemFL emptyFL
-- Nothing
--
-- This will always return 'Just' if there is a 'Focus'.
--
-- prop> hasFocusFL fl ==> isJust (getFocusItemFL fl)
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@
-- is the length of the 'FocusList'.
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

-- | Set the item the 'FocusList' is focusing on.
--
-- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30]
-- >>> setFocusItemFL 0 fl
-- FocusList (Focus 1) [10,0,30]
--
-- >>> setFocusItemFL "hello" emptyFL
-- FocusList NoFocus []
--
-- Note: this function forces the updated item.  The following throws an
-- exception from 'undefined' even though we updated the focused item at index
-- 1, but lookup the item at index 0.
--
-- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30]
-- >>> let newFl = setFocusItemFL undefined fl
-- >>> lookupFL 0 newFl
-- *** Exception: ...
-- ...
--
-- This is a specialization of 'updateFocusItemFL':
--
-- prop> updateFocusItemFL (const a) fl == setFocusItemFL a fl
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@
-- is the length of the 'FocusList'.
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

-- | Update the item the 'FocusList' is focusing on.  Do nothing if
-- the 'FocusList' is empty.
--
-- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30]
-- >>> updateFocusItemFL (\a -> a + 5) fl
-- FocusList (Focus 1) [10,25,30]
--
-- >>> updateFocusItemFL (\a -> a * 100) emptyFL
-- FocusList NoFocus []
--
-- Note: this function forces the updated item.  The following throws an
-- exception from 'undefined' even though we updated the focused item at index
-- 1, but lookup the item at index 0.
--
-- >>> let Just fl = fromListFL (Focus 1) [10, 20, 30]
-- >>> let newFl = updateFocusItemFL (const undefined) fl
-- >>> lookupFL 0 newFl
-- *** Exception: ...
-- ...
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the 'Focus', and @n@
-- is the length of the 'FocusList'.
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 }

-- | Lookup the element at the specified index, counting from 0.
--
-- >>> let Just fl = fromListFL (Focus 0) ['a'..'c']
-- >>> lookupFL 0 fl
-- Just 'a'
--
-- Returns 'Nothing' if the index is out of bounds.
--
-- >>> let Just fl = fromListFL (Focus 0) ['a'..'c']
-- >>> lookupFL 100 fl
-- Nothing
-- >>> lookupFL (-1) fl
-- Nothing
--
-- Always returns 'Nothing' if the 'FocusList' is empty.
--
-- prop> lookupFL i emptyFL == Nothing
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the index you want to look up, and @n@
-- is the length of the 'FocusList'.
lookupFL
  :: Int  -- ^ Index to lookup.
  -> 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)

-- | Insert a new value into the 'FocusList'.  The 'Focus' of the list is
-- changed appropriately.
--
-- Inserting an element into an empty 'FocusList' will set the 'Focus' on
-- that element.
--
-- >>> insertFL 0 "hello" emptyFL
-- FocusList (Focus 0) ["hello"]
--
-- The 'Focus' will not be changed if you insert a new element after the
-- current 'Focus'.
--
-- >>> insertFL 1 "hello" (singletonFL "bye")
-- FocusList (Focus 0) ["bye","hello"]
--
-- The 'Focus' will be bumped up by one if you insert a new element before
-- the current 'Focus'.
--
-- >>> insertFL 0 "hello" (singletonFL "bye")
-- FocusList (Focus 1) ["hello","bye"]
--
-- Behaves like @Data.Sequence.'Data.Sequence.insertAt'@. If the index is out of bounds, it will be
-- inserted at the nearest available index
--
-- >>> insertFL 100 "hello" emptyFL
-- FocusList (Focus 0) ["hello"]
--
-- >>> insertFL 100 "bye" (singletonFL "hello")
-- FocusList (Focus 0) ["hello","bye"]
--
-- >>> insertFL (-1) "bye" (singletonFL "hello")
-- FocusList (Focus 1) ["bye","hello"]
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the index you want to insert at, and @n@
-- is the length of the 'FocusList'.
insertFL
  :: Int  -- ^ The index at which to insert the new element.
  -> a    -- ^ The new element.
  -> 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
        }

-- | Remove an element from a 'FocusList'.
--
-- If the element to remove is not the 'Focus', then update the 'Focus'
-- accordingly.
--
-- For example, if the 'Focus' is on index 1, and we have removed index 2, then
-- the focus is not affected, so it is not changed.
--
-- >>> let focusList = unsafeFromListFL (Focus 1) ["cat","goat","dog","hello"]
-- >>> removeFL 2 focusList
-- Just (FocusList (Focus 1) ["cat","goat","hello"])
--
-- If the 'Focus' is on index 2 and we have removed index 1, then the 'Focus'
-- will be moved back one element to set to index 1.
--
-- >>> let focusList = unsafeFromListFL (Focus 2) ["cat","goat","dog","hello"]
-- >>> removeFL 1 focusList
-- Just (FocusList (Focus 1) ["cat","dog","hello"])
--
-- If we remove the 'Focus', then the next item is set to have the 'Focus'.
--
-- >>> let focusList = unsafeFromListFL (Focus 0) ["cat","goat","dog","hello"]
-- >>> removeFL 0 focusList
-- Just (FocusList (Focus 0) ["goat","dog","hello"])
--
-- If the element to remove is the only element in the list, then the 'Focus'
-- will be set to 'NoFocus'.
--
-- >>> let focusList = unsafeFromListFL (Focus 0) ["hello"]
-- >>> removeFL 0 focusList
-- Just (FocusList NoFocus [])
--
-- If the 'Int' for the index to remove is either less than 0 or greater then
-- the length of the list, then 'Nothing' is returned.
--
-- >>> let focusList = unsafeFromListFL (Focus 0) ["hello"]
-- >>> removeFL (-1) focusList
-- Nothing
--
-- >>> let focusList = unsafeFromListFL (Focus 1) ["hello","bye","cat"]
-- >>> removeFL 3 focusList
-- Nothing
--
-- If the 'FocusList' passed in is 'Empty', then 'Nothing' is returned.
--
-- >>> removeFL 0 emptyFL
-- Nothing
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is index of the element to remove, and @n@
-- is the length of the 'FocusList'.
removeFL
  :: Int          -- ^ Index of the element to remove from the 'FocusList'.
  -> FocusList a  -- ^ The 'FocusList' to remove an element from.
  -> 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 =
    -- Return Nothing if the removal position is out of bounds.
    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 =
    -- Return an empty focus list if there is currently only one element
    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

-- | Find the index of the first element in the 'FocusList'.
--
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"]
-- >>> indexOfFL "hello" fl
-- Just 0
--
-- If more than one element exists, then return the index of the first one.
--
-- >>> let Just fl = fromListFL (Focus 1) ["dog", "cat", "cat"]
-- >>> indexOfFL "cat" fl
-- Just 1
--
-- If the element doesn't exist, then return 'Nothing'
--
-- >>> let Just fl = fromListFL (Focus 1) ["foo", "bar", "baz"]
-- >>> indexOfFL "hogehoge" fl
-- Nothing
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

-- | Delete an element from a 'FocusList'.
--
-- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "tree"]
-- >>> deleteFL "bye" fl
-- FocusList (Focus 0) ["hello","tree"]
--
-- The focus will be updated if an item before it is deleted.
--
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"]
-- >>> deleteFL "hello" fl
-- FocusList (Focus 0) ["bye","tree"]
--
-- If there are multiple matching elements in the 'FocusList', remove them all.
--
-- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "bye"]
-- >>> deleteFL "bye" fl
-- FocusList (Focus 0) ["hello"]
--
-- If there are no matching elements, return the original 'FocusList'.
--
-- >>> let Just fl = fromListFL (Focus 2) ["hello", "good", "bye"]
-- >>> deleteFL "frog" fl
-- FocusList (Focus 2) ["hello","good","bye"]
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

-- | Set the 'Focus' for a 'FocusList'.
--
-- This is just like 'updateFocusFL', but doesn't return the newly focused item.
--
-- prop> setFocusFL i fl == fmap snd (updateFocusFL i fl)
--
-- /complexity/: @O(1)@
setFocusFL :: Int -> FocusList a -> Maybe (FocusList a)
setFocusFL :: Int -> FocusList a -> Maybe (FocusList a)
setFocusFL Int
i FocusList a
fl
  -- Can't set a 'Focus' for an empty 'FocusList'.
  | 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

-- | Update the 'Focus' for a 'FocusList' and get the new focused element.
--
-- >>> updateFocusFL 1 =<< fromListFL (Focus 2) ["hello","bye","dog","cat"]
-- Just ("bye",FocusList (Focus 1) ["hello","bye","dog","cat"])
--
-- If the 'FocusList' is empty, then return 'Nothing'.
--
-- >>> updateFocusFL 1 emptyFL
-- Nothing
--
-- If the new focus is less than 0, or greater than or equal to the length of
-- the 'FocusList', then return 'Nothing'.
--
-- >>> updateFocusFL (-1) =<< fromListFL (Focus 2) ["hello","bye","dog","cat"]
-- Nothing
--
-- >>> updateFocusFL 4 =<< fromListFL (Focus 2) ["hello","bye","dog","cat"]
-- Nothing
--
-- /complexity/: @O(log(min(i, n - i)))@ where @i@ is the new index to put the 'Focus' on,
-- and @n@ -- is the length of the 'FocusList'.
updateFocusFL
  :: Int  -- ^ The new index to put the 'Focus' on.
  -> FocusList a
  -> Maybe (a, FocusList a)
  -- ^ A tuple of the new element that gets the 'Focus', and the new
  -- 'FocusList'.
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)

-- | Find a value in a 'FocusList'.  Similar to @Data.List.'Data.List.find'@.
--
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "tree"]
-- >>> findFL (\a -> a == "hello") fl
-- Just "hello"
--
-- This will only find the first value.
--
-- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "bye"]
-- >>> findFL (\a -> a == "bye") fl
-- Just "bye"
--
-- If no values match the comparison, this will return 'Nothing'.
--
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "parrot"]
-- >>> findFL (\a -> a == "ball") fl
-- Nothing
--
-- /complexity/: @O(n)@ where @n@ is the length of the 'FocusList'.
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

-- | Move an existing item in a 'FocusList' to a new index.
--
-- The 'Focus' gets updated appropriately when moving items.
--
-- >>> let Just fl = fromListFL (Focus 1) ["hello", "bye", "parrot"]
-- >>> moveFromToFL 0 1 fl
-- Just (FocusList (Focus 0) ["bye","hello","parrot"])
--
-- The 'Focus' may not get updated if it is not involved.
--
-- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "parrot"]
-- >>> moveFromToFL 1 2 fl
-- Just (FocusList (Focus 0) ["hello","parrot","bye"])
--
-- If the element with the 'Focus' is moved, then the 'Focus' will be updated
-- appropriately.
--
-- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"]
-- >>> moveFromToFL 2 0 fl
-- Just (FocusList (Focus 0) ["parrot","hello","bye"])
--
-- If the index of the item to move is out bounds, then 'Nothing' will be returned.
--
-- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"]
-- >>> moveFromToFL 3 0 fl
-- Nothing
--
-- If the new index is out of bounds, then 'Nothing' wil be returned.
--
-- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "parrot"]
-- >>> moveFromToFL 1 (-1) fl
-- Nothing
--
-- /complexity/: @O(log n)@ where @n@ is the length of the 'FocusList'.
moveFromToFL
  :: Show a
  => Int  -- ^ Index of the item to move.
  -> Int  -- ^ New index for the item.
  -> 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

-- | Intersperse a new element between existing elements in the 'FocusList'.
--
-- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "cat"]
-- >>> intersperseFL "foo" fl
-- FocusList (Focus 0) ["hello","foo","bye","foo","cat"]
--
-- The 'Focus' is updated accordingly.
--
-- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "cat", "goat"]
-- >>> intersperseFL "foo" fl
-- FocusList (Focus 4) ["hello","foo","bye","foo","cat","foo","goat"]
--
-- The item with the 'Focus' should never change after calling 'intersperseFL'.
--
-- prop> getFocusItemFL (fl :: FocusList Int) == getFocusItemFL (intersperseFL a fl)
--
-- 'intersperseFL' should not have any effect on a 'FocusList' with less than
-- two items.
--
-- prop> emptyFL == intersperseFL x emptyFL
-- prop> singletonFL a == intersperseFL x (singletonFL a)
--
-- /complexity/: @O(n)@ where @n@ is the length of the 'FocusList'.
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)
    }

-- | Reverse a 'FocusList'.  The 'Focus' is updated accordingly.
--
-- >>> let Just fl = fromListFL (Focus 0) ["hello", "bye", "cat"]
-- >>> reverseFL fl
-- FocusList (Focus 2) ["cat","bye","hello"]
--
-- >>> let Just fl = fromListFL (Focus 2) ["hello", "bye", "cat", "goat"]
-- >>> reverseFL fl
-- FocusList (Focus 1) ["goat","cat","bye","hello"]
--
-- The item with the 'Focus' should never change after calling 'intersperseFL'.
--
-- prop> getFocusItemFL (fl :: FocusList Int) == getFocusItemFL (reverseFL fl)
--
-- Reversing twice should not change anything.
--
-- prop> (fl :: FocusList Int) == reverseFL (reverseFL fl)
--
-- Reversing empty lists and single lists should not do anything.
--
-- prop> emptyFL == reverseFL emptyFL
-- prop> singletonFL a == reverseFL (singletonFL a)
--
-- /complexity/: @O(n)@ where @n@ is the length of the 'FocusList'.
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)
    }

-- | Sort a 'FocusList'.
--
-- The 'Focus' will stay with the element that has the 'Focus'.
--
-- >>> let Just fl = fromListFL (Focus 2) ["b", "c", "a"]
-- >>> sortByFL compare fl
-- FocusList (Focus 0) ["a","b","c"]
--
-- Nothing will happen if you try to sort an empty 'FocusList', or a
-- 'FocusList' with only one element.
--
-- prop> emptyFL == sortByFL compare emptyFL
-- prop> singletonFL a == sortByFL compare (singletonFL a)
--
-- The element with the 'Focus' should be the same before and after sorting.
--
-- prop> getFocusItemFL (fl :: FocusList Int) == getFocusItemFL (sortByFL compare fl)
--
-- Sorting a 'FocusList' and getting the underlying 'Seq' should be the same as
-- getting the underlying 'Seq' and then sorting it.
--
-- prop> toSeqFL (sortByFL compare (fl :: FocusList Int)) == sortBy compare (toSeqFL fl)
--
-- __WARNING__: The computational complexity for this is very bad. It should be
-- able to be done in @O(n * log n)@, but the current implementation is
-- @O(n^2)@ (or worse), where @n@ is the length of the 'FocusList'.  This
-- function could be implemented the same way
-- @Data.Sequence.'Data.Sequence.sortBy'@ is implemented.  However, a small
-- change needs to be added to that function to keep track of the 'Focus' in
-- the 'FocusList' and make sure it gets updated properly.  If you're
-- interested in fixing this, please send a PR.
sortByFL
  :: forall a
   . (a -> a -> Ordering) -- ^ The function to use to compare elements.
  -> 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 -- ^ The sequence that needs to be sorted.
      -> Maybe Int
         -- ^ Whether or not we are tracking a 'Focus' that needs to be updated.
      -> (Seq a, Maybe Int)
    -- Trying to sort an empty sequence with a 'Focus'.  This should never happen.
    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."
    -- Trying to sort an empty sequence.
    go Seq a
Empty Maybe Int
Nothing = (Seq a
forall a. Seq a
Empty, Maybe Int
forall a. Maybe a
Nothing)
    -- Trying to sort a non-empty sequence with no focus.
    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)
    -- Trying to sort a non-empty sequence with the top element having the focus.
    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))
    -- Trying to sort a non-empty sequence where some element other than the
    -- top element has the focus.
    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))