{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveFoldable#-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE DeriveGeneric #-}
-- | This module provides a scrollable list type and functions for
-- manipulating and rendering it.
--
-- Note that lenses are provided for direct manipulation purposes, but
-- lenses are *not* safe and should be used with care. (For example,
-- 'listElementsL' permits direct manipulation of the list container
-- without performing bounds checking on the selected index.) If you
-- need a safe API, consider one of the various functions for list
-- manipulation. For example, instead of 'listElementsL', consider
-- 'listReplace'.
module Brick.Widgets.List
  ( GenericList
  , List

  -- * Constructing a list
  , list

  -- * Rendering a list
  , renderList
  , renderListWithIndex

  -- * Handling events
  , handleListEvent
  , handleListEventVi

  -- * Lenses
  , listElementsL
  , listSelectedL
  , listNameL
  , listItemHeightL

  -- * Accessors
  , listElements
  , listName
  , listSelectedElement
  , listSelected
  , listItemHeight

  -- * Manipulating a list
  , listMoveBy
  , listMoveTo
  , listMoveToElement
  , listFindBy
  , listMoveUp
  , listMoveDown
  , listMoveByPages
  , listMovePageUp
  , listMovePageDown
  , listMoveToBeginning
  , listMoveToEnd
  , listInsert
  , listRemove
  , listReplace
  , listClear
  , listReverse
  , listModify

  -- * Attributes
  , listAttr
  , listSelectedAttr
  , listSelectedFocusedAttr

  -- * Classes
  , Splittable(..)
  , Reversible(..)
  )
where

import Prelude hiding (reverse, splitAt)

import Control.Applicative ((<|>))
#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>), pure)
import Data.Foldable (Foldable, find, toList)
import Data.Traversable (Traversable)
#else
import Data.Foldable (find, toList)
#endif
import Control.Monad.Trans.State (evalState, get, put)

import Lens.Micro ((^.), (^?), (&), (.~), (%~), _2, _head, set)
import Data.Functor (($>))
import Data.List.NonEmpty (NonEmpty((:|)))
import Data.Maybe (fromMaybe)
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup, (<>))
#endif
import Data.Semigroup (sconcat)
import qualified Data.Sequence as Seq
import Graphics.Vty (Event(..), Key(..), Modifier(..))
import qualified Data.Vector as V
import GHC.Generics (Generic)

import Brick.Types
import Brick.Main (lookupViewport)
import Brick.Widgets.Core
import Brick.Util (clamp)
import Brick.AttrMap

-- | List state. Lists have a container @t@ of element type @e@ that is
-- the data stored by the list. Internally, Lists handle the following
-- events by default:
--
-- * Up/down arrow keys: move cursor of selected item
-- * Page up / page down keys: move cursor of selected item by one page
--   at a time (based on the number of items shown)
-- * Home/end keys: move cursor of selected item to beginning or end of
--   list
--
-- The 'List' type synonym fixes @t@ to 'V.Vector' for compatibility
-- with previous versions of this library.
--
-- For a container type to be usable with 'GenericList', it must have
-- instances of 'Traversable' and 'Splittable'. The following functions
-- impose further constraints:
--
-- * 'listInsert': 'Applicative' and 'Semigroup'
-- * 'listRemove': 'Semigroup'
-- * 'listClear': 'Monoid'
-- * 'listReverse': 'Reversible'
--
data GenericList n t e =
    List { GenericList n t e -> t e
listElements :: !(t e)
         -- ^ The list's sequence of elements.
         , GenericList n t e -> Maybe Int
listSelected :: !(Maybe Int)
         -- ^ The list's selected element index, if any.
         , GenericList n t e -> n
listName :: n
         -- ^ The list's name.
         , GenericList n t e -> Int
listItemHeight :: Int
         -- ^ The height of an individual item in the list.
         } deriving (a -> GenericList n t b -> GenericList n t a
(a -> b) -> GenericList n t a -> GenericList n t b
(forall a b. (a -> b) -> GenericList n t a -> GenericList n t b)
-> (forall a b. a -> GenericList n t b -> GenericList n t a)
-> Functor (GenericList n t)
forall a b. a -> GenericList n t b -> GenericList n t a
forall a b. (a -> b) -> GenericList n t a -> GenericList n t b
forall n (t :: * -> *) a b.
Functor t =>
a -> GenericList n t b -> GenericList n t a
forall n (t :: * -> *) a b.
Functor t =>
(a -> b) -> GenericList n t a -> GenericList n t b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> GenericList n t b -> GenericList n t a
$c<$ :: forall n (t :: * -> *) a b.
Functor t =>
a -> GenericList n t b -> GenericList n t a
fmap :: (a -> b) -> GenericList n t a -> GenericList n t b
$cfmap :: forall n (t :: * -> *) a b.
Functor t =>
(a -> b) -> GenericList n t a -> GenericList n t b
Functor, GenericList n t a -> Bool
(a -> m) -> GenericList n t a -> m
(a -> b -> b) -> b -> GenericList n t a -> b
(forall m. Monoid m => GenericList n t m -> m)
-> (forall m a. Monoid m => (a -> m) -> GenericList n t a -> m)
-> (forall m a. Monoid m => (a -> m) -> GenericList n t a -> m)
-> (forall a b. (a -> b -> b) -> b -> GenericList n t a -> b)
-> (forall a b. (a -> b -> b) -> b -> GenericList n t a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenericList n t a -> b)
-> (forall b a. (b -> a -> b) -> b -> GenericList n t a -> b)
-> (forall a. (a -> a -> a) -> GenericList n t a -> a)
-> (forall a. (a -> a -> a) -> GenericList n t a -> a)
-> (forall a. GenericList n t a -> [a])
-> (forall a. GenericList n t a -> Bool)
-> (forall a. GenericList n t a -> Int)
-> (forall a. Eq a => a -> GenericList n t a -> Bool)
-> (forall a. Ord a => GenericList n t a -> a)
-> (forall a. Ord a => GenericList n t a -> a)
-> (forall a. Num a => GenericList n t a -> a)
-> (forall a. Num a => GenericList n t a -> a)
-> Foldable (GenericList n t)
forall a. Eq a => a -> GenericList n t a -> Bool
forall a. Num a => GenericList n t a -> a
forall a. Ord a => GenericList n t a -> a
forall m. Monoid m => GenericList n t m -> m
forall a. GenericList n t a -> Bool
forall a. GenericList n t a -> Int
forall a. GenericList n t a -> [a]
forall a. (a -> a -> a) -> GenericList n t a -> a
forall m a. Monoid m => (a -> m) -> GenericList n t a -> m
forall b a. (b -> a -> b) -> b -> GenericList n t a -> b
forall a b. (a -> b -> b) -> b -> GenericList n t a -> b
forall n (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> GenericList n t a -> Bool
forall n (t :: * -> *) a.
(Foldable t, Num a) =>
GenericList n t a -> a
forall n (t :: * -> *) a.
(Foldable t, Ord a) =>
GenericList n t a -> a
forall n (t :: * -> *) m.
(Foldable t, Monoid m) =>
GenericList n t m -> m
forall n (t :: * -> *) a. Foldable t => GenericList n t a -> Bool
forall n (t :: * -> *) a. Foldable t => GenericList n t a -> Int
forall n (t :: * -> *) a. Foldable t => GenericList n t a -> [a]
forall n (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> GenericList n t a -> a
forall n (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> GenericList n t a -> m
forall n (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> GenericList n t a -> b
forall n (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> GenericList n t a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: GenericList n t a -> a
$cproduct :: forall n (t :: * -> *) a.
(Foldable t, Num a) =>
GenericList n t a -> a
sum :: GenericList n t a -> a
$csum :: forall n (t :: * -> *) a.
(Foldable t, Num a) =>
GenericList n t a -> a
minimum :: GenericList n t a -> a
$cminimum :: forall n (t :: * -> *) a.
(Foldable t, Ord a) =>
GenericList n t a -> a
maximum :: GenericList n t a -> a
$cmaximum :: forall n (t :: * -> *) a.
(Foldable t, Ord a) =>
GenericList n t a -> a
elem :: a -> GenericList n t a -> Bool
$celem :: forall n (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> GenericList n t a -> Bool
length :: GenericList n t a -> Int
$clength :: forall n (t :: * -> *) a. Foldable t => GenericList n t a -> Int
null :: GenericList n t a -> Bool
$cnull :: forall n (t :: * -> *) a. Foldable t => GenericList n t a -> Bool
toList :: GenericList n t a -> [a]
$ctoList :: forall n (t :: * -> *) a. Foldable t => GenericList n t a -> [a]
foldl1 :: (a -> a -> a) -> GenericList n t a -> a
$cfoldl1 :: forall n (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> GenericList n t a -> a
foldr1 :: (a -> a -> a) -> GenericList n t a -> a
$cfoldr1 :: forall n (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> GenericList n t a -> a
foldl' :: (b -> a -> b) -> b -> GenericList n t a -> b
$cfoldl' :: forall n (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> GenericList n t a -> b
foldl :: (b -> a -> b) -> b -> GenericList n t a -> b
$cfoldl :: forall n (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> GenericList n t a -> b
foldr' :: (a -> b -> b) -> b -> GenericList n t a -> b
$cfoldr' :: forall n (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> GenericList n t a -> b
foldr :: (a -> b -> b) -> b -> GenericList n t a -> b
$cfoldr :: forall n (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> GenericList n t a -> b
foldMap' :: (a -> m) -> GenericList n t a -> m
$cfoldMap' :: forall n (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> GenericList n t a -> m
foldMap :: (a -> m) -> GenericList n t a -> m
$cfoldMap :: forall n (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> GenericList n t a -> m
fold :: GenericList n t m -> m
$cfold :: forall n (t :: * -> *) m.
(Foldable t, Monoid m) =>
GenericList n t m -> m
Foldable, Functor (GenericList n t)
Foldable (GenericList n t)
Functor (GenericList n t)
-> Foldable (GenericList n t)
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> GenericList n t a -> f (GenericList n t b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    GenericList n t (f a) -> f (GenericList n t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> GenericList n t a -> m (GenericList n t b))
-> (forall (m :: * -> *) a.
    Monad m =>
    GenericList n t (m a) -> m (GenericList n t a))
-> Traversable (GenericList n t)
(a -> f b) -> GenericList n t a -> f (GenericList n t b)
forall n (t :: * -> *). Traversable t => Functor (GenericList n t)
forall n (t :: * -> *). Traversable t => Foldable (GenericList n t)
forall n (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
GenericList n t (m a) -> m (GenericList n t a)
forall n (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
GenericList n t (f a) -> f (GenericList n t a)
forall n (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> GenericList n t a -> m (GenericList n t b)
forall n (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> GenericList n t a -> f (GenericList n t b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
GenericList n t (m a) -> m (GenericList n t a)
forall (f :: * -> *) a.
Applicative f =>
GenericList n t (f a) -> f (GenericList n t a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> GenericList n t a -> m (GenericList n t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenericList n t a -> f (GenericList n t b)
sequence :: GenericList n t (m a) -> m (GenericList n t a)
$csequence :: forall n (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
GenericList n t (m a) -> m (GenericList n t a)
mapM :: (a -> m b) -> GenericList n t a -> m (GenericList n t b)
$cmapM :: forall n (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> GenericList n t a -> m (GenericList n t b)
sequenceA :: GenericList n t (f a) -> f (GenericList n t a)
$csequenceA :: forall n (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
GenericList n t (f a) -> f (GenericList n t a)
traverse :: (a -> f b) -> GenericList n t a -> f (GenericList n t b)
$ctraverse :: forall n (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> GenericList n t a -> f (GenericList n t b)
$cp2Traversable :: forall n (t :: * -> *). Traversable t => Foldable (GenericList n t)
$cp1Traversable :: forall n (t :: * -> *). Traversable t => Functor (GenericList n t)
Traversable, Int -> GenericList n t e -> ShowS
[GenericList n t e] -> ShowS
GenericList n t e -> String
(Int -> GenericList n t e -> ShowS)
-> (GenericList n t e -> String)
-> ([GenericList n t e] -> ShowS)
-> Show (GenericList n t e)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall n (t :: * -> *) e.
(Show n, Show (t e)) =>
Int -> GenericList n t e -> ShowS
forall n (t :: * -> *) e.
(Show n, Show (t e)) =>
[GenericList n t e] -> ShowS
forall n (t :: * -> *) e.
(Show n, Show (t e)) =>
GenericList n t e -> String
showList :: [GenericList n t e] -> ShowS
$cshowList :: forall n (t :: * -> *) e.
(Show n, Show (t e)) =>
[GenericList n t e] -> ShowS
show :: GenericList n t e -> String
$cshow :: forall n (t :: * -> *) e.
(Show n, Show (t e)) =>
GenericList n t e -> String
showsPrec :: Int -> GenericList n t e -> ShowS
$cshowsPrec :: forall n (t :: * -> *) e.
(Show n, Show (t e)) =>
Int -> GenericList n t e -> ShowS
Show, (forall x. GenericList n t e -> Rep (GenericList n t e) x)
-> (forall x. Rep (GenericList n t e) x -> GenericList n t e)
-> Generic (GenericList n t e)
forall x. Rep (GenericList n t e) x -> GenericList n t e
forall x. GenericList n t e -> Rep (GenericList n t e) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall n (t :: * -> *) e x.
Rep (GenericList n t e) x -> GenericList n t e
forall n (t :: * -> *) e x.
GenericList n t e -> Rep (GenericList n t e) x
$cto :: forall n (t :: * -> *) e x.
Rep (GenericList n t e) x -> GenericList n t e
$cfrom :: forall n (t :: * -> *) e x.
GenericList n t e -> Rep (GenericList n t e) x
Generic)

suffixLenses ''GenericList

-- | An alias for 'GenericList' specialized to use a 'Vector' as its
-- container type.
type List n e = GenericList n V.Vector e

instance Named (GenericList n t e) n where
    getName :: GenericList n t e -> n
getName = GenericList n t e -> n
forall n (t :: * -> *) e. GenericList n t e -> n
listName

-- | Ordered container types that can be split at a given index. An
-- instance of this class is required for a container type to be usable
-- with 'GenericList'.
class Splittable t where
    {-# MINIMAL splitAt #-}

    -- | Split at the given index. Equivalent to @(take n xs, drop n xs)@
    -- and therefore total.
    splitAt :: Int -> t a -> (t a, t a)

    -- | Slice the structure. Equivalent to @(take n . drop i) xs@ and
    -- therefore total.
    --
    -- The default implementation applies 'splitAt' two times: first to
    -- drop elements leading up to the slice, and again to drop elements
    -- after the slice.
    slice :: Int {- ^ start index -} -> Int {- ^ length -} -> t a -> t a
    slice Int
i Int
n = (t a, t a) -> t a
forall a b. (a, b) -> a
fst ((t a, t a) -> t a) -> (t a -> (t a, t a)) -> t a -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t a -> (t a, t a)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
n (t a -> (t a, t a)) -> (t a -> t a) -> t a -> (t a, t a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t a, t a) -> t a
forall a b. (a, b) -> b
snd ((t a, t a) -> t a) -> (t a -> (t a, t a)) -> t a -> t a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> t a -> (t a, t a)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
i

-- | /O(1)/ 'splitAt'.
instance Splittable V.Vector where
    splitAt :: Int -> Vector a -> (Vector a, Vector a)
splitAt = Int -> Vector a -> (Vector a, Vector a)
forall a. Int -> Vector a -> (Vector a, Vector a)
V.splitAt

-- | /O(log(min(i,n-i)))/ 'splitAt'.
instance Splittable Seq.Seq where
    splitAt :: Int -> Seq a -> (Seq a, Seq a)
splitAt = Int -> Seq a -> (Seq a, Seq a)
forall a. Int -> Seq a -> (Seq a, Seq a)
Seq.splitAt

-- | Ordered container types where the order of elements can be
-- reversed. Only required if you want to use 'listReverse'.
class Reversible t where
    {-# MINIMAL reverse #-}
    reverse :: t a -> t a

-- | /O(n)/ 'reverse'
instance Reversible V.Vector where
  reverse :: Vector a -> Vector a
reverse = Vector a -> Vector a
forall a. Vector a -> Vector a
V.reverse

-- | /O(n)/ 'reverse'
instance Reversible Seq.Seq where
  reverse :: Seq a -> Seq a
reverse = Seq a -> Seq a
forall a. Seq a -> Seq a
Seq.reverse

-- | Handle events for list cursor movement.  Events handled are:
--
-- * Up (up arrow key)
-- * Down (down arrow key)
-- * Page Up (PgUp)
-- * Page Down (PgDown)
-- * Go to first element (Home)
-- * Go to last element (End)
handleListEvent :: (Foldable t, Splittable t, Ord n)
                => Event
                -> GenericList n t e
                -> EventM n (GenericList n t e)
handleListEvent :: Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEvent Event
e GenericList n t e
theList =
    case Event
e of
        EvKey Key
KUp [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveUp GenericList n t e
theList
        EvKey Key
KDown [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown GenericList n t e
theList
        EvKey Key
KHome [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToBeginning GenericList n t e
theList
        EvKey Key
KEnd [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToEnd GenericList n t e
theList
        EvKey Key
KPageDown [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
GenericList n t e -> EventM n (GenericList n t e)
listMovePageDown GenericList n t e
theList
        EvKey Key
KPageUp [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
GenericList n t e -> EventM n (GenericList n t e)
listMovePageUp GenericList n t e
theList
        Event
_ -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericList n t e
theList

-- | Enable list movement with the vi keys with a fallback handler if
-- none match. Use 'handleListEventVi' 'handleListEvent' in place of
-- 'handleListEvent' to add the vi keys bindings to the standard ones.
-- Movements handled include:
--
-- * Up (k)
-- * Down (j)
-- * Page Up (Ctrl-b)
-- * Page Down (Ctrl-f)
-- * Half Page Up (Ctrl-u)
-- * Half Page Down (Ctrl-d)
-- * Go to first element (g)
-- * Go to last element (G)
handleListEventVi :: (Foldable t, Splittable t, Ord n)
                  => (Event -> GenericList n t e -> EventM n (GenericList n t e))
                  -- ^ Fallback event handler to use if none of the vi keys
                  -- match.
                  -> Event
                  -> GenericList n t e
                  -> EventM n (GenericList n t e)
handleListEventVi :: (Event -> GenericList n t e -> EventM n (GenericList n t e))
-> Event -> GenericList n t e -> EventM n (GenericList n t e)
handleListEventVi Event -> GenericList n t e -> EventM n (GenericList n t e)
fallback Event
e GenericList n t e
theList =
    case Event
e of
        EvKey (KChar Char
'k') [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveUp GenericList n t e
theList
        EvKey (KChar Char
'j') [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown GenericList n t e
theList
        EvKey (KChar Char
'g') [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToBeginning GenericList n t e
theList
        EvKey (KChar Char
'G') [] -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToEnd GenericList n t e
theList
        EvKey (KChar Char
'f') [Modifier
MCtrl] -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
GenericList n t e -> EventM n (GenericList n t e)
listMovePageDown GenericList n t e
theList
        EvKey (KChar Char
'b') [Modifier
MCtrl] -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
GenericList n t e -> EventM n (GenericList n t e)
listMovePageUp GenericList n t e
theList
        EvKey (KChar Char
'd') [Modifier
MCtrl] -> Double -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> GenericList n t e -> EventM n (GenericList n t e)
listMoveByPages (Double
0.5::Double) GenericList n t e
theList
        EvKey (KChar Char
'u') [Modifier
MCtrl] -> Double -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> GenericList n t e -> EventM n (GenericList n t e)
listMoveByPages (-Double
0.5::Double) GenericList n t e
theList
        Event
_ -> Event -> GenericList n t e -> EventM n (GenericList n t e)
fallback Event
e GenericList n t e
theList

-- | Move the list selection to the first element in the list.
listMoveToBeginning :: (Foldable t, Splittable t)
                    => GenericList n t e
                    -> GenericList n t e
listMoveToBeginning :: GenericList n t e -> GenericList n t e
listMoveToBeginning = Int -> GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
0

-- | Move the list selection to the last element in the list.
listMoveToEnd :: (Foldable t, Splittable t)
              => GenericList n t e
              -> GenericList n t e
listMoveToEnd :: GenericList n t e -> GenericList n t e
listMoveToEnd GenericList n t e
l = Int -> GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (t e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (t e -> Int) -> t e -> Int
forall a b. (a -> b) -> a -> b
$ GenericList n t e -> t e
forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList n t e
l) GenericList n t e
l

-- | The top-level attribute used for the entire list.
listAttr :: AttrName
listAttr :: AttrName
listAttr = AttrName
"list"

-- | The attribute used only for the currently-selected list item when
-- the list does not have focus. Extends 'listAttr'.
listSelectedAttr :: AttrName
listSelectedAttr :: AttrName
listSelectedAttr = AttrName
listAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"selected"

-- | The attribute used only for the currently-selected list item when
-- the list has focus. Extends 'listSelectedAttr'.
listSelectedFocusedAttr :: AttrName
listSelectedFocusedAttr :: AttrName
listSelectedFocusedAttr = AttrName
listSelectedAttr AttrName -> AttrName -> AttrName
forall a. Semigroup a => a -> a -> a
<> AttrName
"focused"

-- | Construct a list in terms of container 't' with element type 'e'.
list :: (Foldable t)
     => n
     -- ^ The list name (must be unique)
     -> t e
     -- ^ The initial list contents
     -> Int
     -- ^ The list item height in rows (all list item widgets must be
     -- this high).
     -> GenericList n t e
list :: n -> t e -> Int -> GenericList n t e
list n
name t e
es Int
h =
    let selIndex :: Maybe Int
selIndex = if t e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
es then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
0
        safeHeight :: Int
safeHeight = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 Int
h
    in t e -> Maybe Int -> n -> Int -> GenericList n t e
forall n (t :: * -> *) e.
t e -> Maybe Int -> n -> Int -> GenericList n t e
List t e
es Maybe Int
selIndex n
name Int
safeHeight

-- | Render a list using the specified item drawing function.
--
-- Evaluates the underlying container up to, and a bit beyond, the
-- selected element. The exact amount depends on available height
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
-- available height.
--
-- Note that this function renders the list with the 'listAttr' as
-- the default attribute and then uses 'listSelectedAttr' as the
-- default attribute for the selected item if the list is not focused
-- or 'listSelectedFocusedAttr' otherwise. This is provided as a
-- convenience so that the item rendering function doesn't have to be
-- concerned with attributes, but if those attributes are undesirable
-- for your purposes, 'forceAttr' can always be used by the item
-- rendering function to ensure that another attribute is used instead.
renderList :: (Traversable t, Splittable t, Ord n, Show n)
           => (Bool -> e -> Widget n)
           -- ^ Rendering function, True for the selected element
           -> Bool
           -- ^ Whether the list has focus
           -> GenericList n t e
           -- ^ The List to be rendered
           -> Widget n
           -- ^ rendered widget
renderList :: (Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> e -> Widget n
drawElem = (Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
renderListWithIndex ((Int -> Bool -> e -> Widget n)
 -> Bool -> GenericList n t e -> Widget n)
-> (Int -> Bool -> e -> Widget n)
-> Bool
-> GenericList n t e
-> Widget n
forall a b. (a -> b) -> a -> b
$ (Bool -> e -> Widget n) -> Int -> Bool -> e -> Widget n
forall a b. a -> b -> a
const Bool -> e -> Widget n
drawElem

-- | Like 'renderList', except the render function is also provided with
-- the index of each element.
--
-- Has the same evaluation characteristics as 'renderList'.
renderListWithIndex :: (Traversable t, Splittable t, Ord n, Show n)
                    => (Int -> Bool -> e -> Widget n)
                    -- ^ Rendering function, taking index, and True for
                    -- the selected element
                    -> Bool
                    -- ^ Whether the list has focus
                    -> GenericList n t e
                    -- ^ The List to be rendered
                    -> Widget n
                    -- ^ rendered widget
renderListWithIndex :: (Int -> Bool -> e -> Widget n)
-> Bool -> GenericList n t e -> Widget n
renderListWithIndex Int -> Bool -> e -> Widget n
drawElem Bool
foc GenericList n t e
l =
    AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
listAttr (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
    Bool
-> GenericList n t e -> (Int -> Bool -> e -> Widget n) -> Widget n
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
Bool
-> GenericList n t e -> (Int -> Bool -> e -> Widget n) -> Widget n
drawListElements Bool
foc GenericList n t e
l Int -> Bool -> e -> Widget n
drawElem

imap :: (Traversable t) => (Int -> a -> b) -> t a -> t b
imap :: (Int -> a -> b) -> t a -> t b
imap Int -> a -> b
f t a
xs =
    let act :: StateT Int Identity (t b)
act = (a -> StateT Int Identity b) -> t a -> StateT Int Identity (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
a -> StateT Int Identity Int
forall (m :: * -> *) s. Monad m => StateT s m s
get StateT Int Identity Int
-> (Int -> StateT Int Identity b) -> StateT Int Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> Int -> StateT Int Identity ()
forall (m :: * -> *) s. Monad m => s -> StateT s m ()
put (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) StateT Int Identity () -> b -> StateT Int Identity b
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> a -> b
f Int
i a
a) t a
xs
    in StateT Int Identity (t b) -> Int -> t b
forall s a. State s a -> s -> a
evalState StateT Int Identity (t b)
act Int
0

-- | Draws the list elements.
--
-- Evaluates the underlying container up to, and a bit beyond, the
-- selected element. The exact amount depends on available height
-- for drawing and 'listItemHeight'. At most, it will evaluate up to
-- element @(i + h + 1)@ where @i@ is the selected index and @h@ is the
-- available height.
drawListElements :: (Traversable t, Splittable t, Ord n, Show n)
                 => Bool
                 -> GenericList n t e
                 -> (Int -> Bool -> e -> Widget n)
                 -> Widget n
drawListElements :: Bool
-> GenericList n t e -> (Int -> Bool -> e -> Widget n) -> Widget n
drawListElements Bool
foc GenericList n t e
l Int -> Bool -> e -> Widget n
drawElem =
    Size -> Size -> RenderM n (Result n) -> Widget n
forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy (RenderM n (Result n) -> Widget n)
-> RenderM n (Result n) -> Widget n
forall a b. (a -> b) -> a -> b
$ do
        Context
c <- RenderM n Context
forall n. RenderM n Context
getContext

        -- Take (numPerHeight * 2) elements, or whatever is left
        let es :: t e
es = Int -> Int -> t e -> t e
forall (t :: * -> *) a. Splittable t => Int -> Int -> t a -> t a
slice Int
start (Int
numPerHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2) (GenericList n t e
lGenericList n t e -> Getting (t e) (GenericList n t e) (t e) -> t e
forall s a. s -> Getting a s a -> a
^.Getting (t e) (GenericList n t e) (t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL)

            idx :: Int
idx = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (GenericList n t e
lGenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL)

            start :: Int
start = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
idx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numPerHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1

            -- The number of items to show is the available height
            -- divided by the item height...
            initialNumPerHeight :: Int
initialNumPerHeight = (Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` (GenericList n t e
lGenericList n t e -> Getting Int (GenericList n t e) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (GenericList n t e) Int
forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
listItemHeightL)
            -- ... but if the available height leaves a remainder of
            -- an item height then we need to ensure that we render an
            -- extra item to show a partial item at the top or bottom to
            -- give the expected result when an item is more than one
            -- row high. (Example: 5 rows available with item height
            -- of 3 yields two items: one fully rendered, the other
            -- rendered with only its top 2 or bottom 2 rows visible,
            -- depending on how the viewport state changes.)
            numPerHeight :: Int
numPerHeight = Int
initialNumPerHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
+
                           if Int
initialNumPerHeight Int -> Int -> Int
forall a. Num a => a -> a -> a
* (GenericList n t e
lGenericList n t e -> Getting Int (GenericList n t e) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (GenericList n t e) Int
forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
listItemHeightL) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Context
cContext -> Getting Int Context Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int Context Int
Lens' Context Int
availHeightL
                           then Int
0
                           else Int
1

            off :: Int
off = Int
start Int -> Int -> Int
forall a. Num a => a -> a -> a
* (GenericList n t e
lGenericList n t e -> Getting Int (GenericList n t e) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (GenericList n t e) Int
forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
listItemHeightL)

            drawnElements :: t (Widget n)
drawnElements = ((Int -> e -> Widget n) -> t e -> t (Widget n))
-> t e -> (Int -> e -> Widget n) -> t (Widget n)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Int -> e -> Widget n) -> t e -> t (Widget n)
forall (t :: * -> *) a b.
Traversable t =>
(Int -> a -> b) -> t a -> t b
imap t e
es ((Int -> e -> Widget n) -> t (Widget n))
-> (Int -> e -> Widget n) -> t (Widget n)
forall a b. (a -> b) -> a -> b
$ \Int
i e
e ->
                let j :: Int
j = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
start
                    isSelected :: Bool
isSelected = Int -> Maybe Int
forall a. a -> Maybe a
Just Int
j Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== GenericList n t e
lGenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL
                    elemWidget :: Widget n
elemWidget = Int -> Bool -> e -> Widget n
drawElem Int
j Bool
isSelected e
e
                    selItemAttr :: Widget n -> Widget n
selItemAttr = if Bool
foc
                                  then AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
listSelectedFocusedAttr
                                  else AttrName -> Widget n -> Widget n
forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
listSelectedAttr
                    makeVisible :: Widget n -> Widget n
makeVisible = if Bool
isSelected
                                  then Widget n -> Widget n
forall n. Widget n -> Widget n
visible (Widget n -> Widget n)
-> (Widget n -> Widget n) -> Widget n -> Widget n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Widget n -> Widget n
forall n. Widget n -> Widget n
selItemAttr
                                  else Widget n -> Widget n
forall a. a -> a
id
                in Widget n -> Widget n
forall n. Widget n -> Widget n
makeVisible Widget n
elemWidget

        Widget n -> RenderM n (Result n)
forall n. Widget n -> RenderM n (Result n)
render (Widget n -> RenderM n (Result n))
-> Widget n -> RenderM n (Result n)
forall a b. (a -> b) -> a -> b
$ n -> ViewportType -> Widget n -> Widget n
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (GenericList n t e
lGenericList n t e -> Getting n (GenericList n t e) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (GenericList n t e) n
forall n (t :: * -> *) e n.
Lens (GenericList n t e) (GenericList n t e) n n
listNameL) ViewportType
Vertical (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                 Location -> Widget n -> Widget n
forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (Int
0, Int
off)) (Widget n -> Widget n) -> Widget n -> Widget n
forall a b. (a -> b) -> a -> b
$
                 [Widget n] -> Widget n
forall n. [Widget n] -> Widget n
vBox ([Widget n] -> Widget n) -> [Widget n] -> Widget n
forall a b. (a -> b) -> a -> b
$ t (Widget n) -> [Widget n]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t (Widget n)
drawnElements

-- | Insert an item into a list at the specified position.
--
-- Complexity: the worse of 'splitAt' and `<>` for the container type.
--
-- @
-- listInsert for 'List': O(n)
-- listInsert for 'Seq.Seq': O(log(min(i, length n - i)))
-- @
listInsert :: (Splittable t, Applicative t, Semigroup (t e))
           => Int
           -- ^ The position at which to insert (0 <= i <= size)
           -> e
           -- ^ The element to insert
           -> GenericList n t e
           -> GenericList n t e
listInsert :: Int -> e -> GenericList n t e -> GenericList n t e
listInsert Int
pos e
e GenericList n t e
l =
    let es :: t e
es = GenericList n t e
lGenericList n t e -> Getting (t e) (GenericList n t e) (t e) -> t e
forall s a. s -> Getting a s a -> a
^.Getting (t e) (GenericList n t e) (t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL
        newSel :: Int
newSel = case GenericList n t e
lGenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
            Maybe Int
Nothing -> Int
0
            Just Int
s -> if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
s
                      then Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                      else Int
s
        (t e
front, t e
back) = Int -> t e -> (t e, t e)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
pos t e
es
    in GenericList n t e
l GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> GenericList n t e -> Identity (GenericList n t e))
-> Maybe Int -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newSel
         GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (t e -> Identity (t e))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL ((t e -> Identity (t e))
 -> GenericList n t e -> Identity (GenericList n t e))
-> t e -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ NonEmpty (t e) -> t e
forall a. Semigroup a => NonEmpty a -> a
sconcat (t e
front t e -> [t e] -> NonEmpty (t e)
forall a. a -> [a] -> NonEmpty a
:| [e -> t e
forall (f :: * -> *) a. Applicative f => a -> f a
pure e
e, t e
back])

-- | Remove an element from a list at the specified position.
--
-- Applies 'splitAt' two times: first to split the structure at the
-- given position, and again to remove the first element from the tail.
-- Consider the asymptotics of `splitAt` for the container type when
-- using this function.
--
-- Complexity: the worse of 'splitAt' and `<>` for the container type.
--
-- @
-- listRemove for 'List': O(n)
-- listRemove for 'Seq.Seq': O(log(min(i, n - i)))
-- @
listRemove :: (Splittable t, Foldable t, Semigroup (t e))
           => Int
           -- ^ The position at which to remove an element (0 <= i <
           -- size)
           -> GenericList n t e
           -> GenericList n t e
listRemove :: Int -> GenericList n t e -> GenericList n t e
listRemove Int
pos GenericList n t e
l | GenericList n t e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null GenericList n t e
l = GenericList n t e
l
                 | Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= GenericList n t e -> Int -> Int
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> Int -> Int
splitClamp GenericList n t e
l Int
pos = GenericList n t e
l
                 | Bool
otherwise =
    let newSel :: Int
newSel = case GenericList n t e
lGenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
            Maybe Int
Nothing -> Int
0
            Just Int
s | Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Int
0
                   | Int
pos Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
s -> Int
pos Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                   | Int
pos  Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
s -> Int
s Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                   | Bool
otherwise -> Int
s
        (t e
front, t e
rest) = Int -> t e -> (t e, t e)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
pos t e
es
        (t e
_, t e
back) = Int -> t e -> (t e, t e)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
1 t e
rest
        es' :: t e
es' = t e
front t e -> t e -> t e
forall a. Semigroup a => a -> a -> a
<> t e
back
        es :: t e
es = GenericList n t e
lGenericList n t e -> Getting (t e) (GenericList n t e) (t e) -> t e
forall s a. s -> Getting a s a -> a
^.Getting (t e) (GenericList n t e) (t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL
    in GenericList n t e
l GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> GenericList n t e -> Identity (GenericList n t e))
-> Maybe Int -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if t e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
es' then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newSel)
         GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (t e -> Identity (t e))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL ((t e -> Identity (t e))
 -> GenericList n t e -> Identity (GenericList n t e))
-> t e -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ t e
es'

-- | Replace the contents of a list with a new set of elements and
-- update the new selected index. If the list is empty, empty selection
-- is used instead. Otherwise, if the specified selected index (via
-- 'Just') is not in the list bounds, zero is used instead.
--
-- Complexity: same as 'splitAt' for the container type.
listReplace :: (Foldable t, Splittable t)
            => t e
            -> Maybe Int
            -> GenericList n t e
            -> GenericList n t e
listReplace :: t e -> Maybe Int -> GenericList n t e -> GenericList n t e
listReplace t e
es Maybe Int
idx GenericList n t e
l =
    let l' :: GenericList n t e
l' = GenericList n t e
l GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (t e -> Identity (t e))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL ((t e -> Identity (t e))
 -> GenericList n t e -> Identity (GenericList n t e))
-> t e -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ t e
es
        newSel :: Maybe Int
newSel = if t e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
es then Maybe Int
forall a. Maybe a
Nothing else Int -> Int
inBoundsOrZero (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
idx
        inBoundsOrZero :: Int -> Int
inBoundsOrZero Int
i
            | Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== GenericList n t e -> Int -> Int
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> Int -> Int
splitClamp GenericList n t e
l' Int
i = Int
i
            | Bool
otherwise = Int
0
    in GenericList n t e
l' GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> GenericList n t e -> Identity (GenericList n t e))
-> Maybe Int -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Int
newSel

-- | Move the list selected index up by one. (Moves the cursor up,
-- subtracts one from the index.)
listMoveUp :: (Foldable t, Splittable t)
           => GenericList n t e
           -> GenericList n t e
listMoveUp :: GenericList n t e -> GenericList n t e
listMoveUp = Int -> GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy (-Int
1)

-- | Move the list selected index up by one page.
listMovePageUp :: (Foldable t, Splittable t, Ord n)
               => GenericList n t e
               -> EventM n (GenericList n t e)
listMovePageUp :: GenericList n t e -> EventM n (GenericList n t e)
listMovePageUp = Double -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> GenericList n t e -> EventM n (GenericList n t e)
listMoveByPages (-Double
1::Double)

-- | Move the list selected index down by one. (Moves the cursor down,
-- adds one to the index.)
listMoveDown :: (Foldable t, Splittable t)
             => GenericList n t e
             -> GenericList n t e
listMoveDown :: GenericList n t e -> GenericList n t e
listMoveDown = Int -> GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
1

-- | Move the list selected index down by one page.
listMovePageDown :: (Foldable t, Splittable t, Ord n)
                 => GenericList n t e
                 -> EventM n (GenericList n t e)
listMovePageDown :: GenericList n t e -> EventM n (GenericList n t e)
listMovePageDown = Double -> GenericList n t e -> EventM n (GenericList n t e)
forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> GenericList n t e -> EventM n (GenericList n t e)
listMoveByPages (Double
1::Double)

-- | Move the list selected index by some (fractional) number of pages.
listMoveByPages :: (Foldable t, Splittable t, Ord n, RealFrac m)
                => m
                -> GenericList n t e
                -> EventM n (GenericList n t e)
listMoveByPages :: m -> GenericList n t e -> EventM n (GenericList n t e)
listMoveByPages m
pages GenericList n t e
theList = do
    Maybe Viewport
v <- n -> EventM n (Maybe Viewport)
forall n. Ord n => n -> EventM n (Maybe Viewport)
lookupViewport (GenericList n t e
theListGenericList n t e -> Getting n (GenericList n t e) n -> n
forall s a. s -> Getting a s a -> a
^.Getting n (GenericList n t e) n
forall n (t :: * -> *) e n.
Lens (GenericList n t e) (GenericList n t e) n n
listNameL)
    case Maybe Viewport
v of
        Maybe Viewport
Nothing -> GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return GenericList n t e
theList
        Just Viewport
vp -> do
            let nElems :: Int
nElems = m -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (m -> Int) -> m -> Int
forall a b. (a -> b) -> a -> b
$ m
pages m -> m -> m
forall a. Num a => a -> a -> a
* Int -> m
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Viewport
vpViewport -> Getting Int Viewport Int -> Int
forall s a. s -> Getting a s a -> a
^.((Int, Int) -> Const Int (Int, Int))
-> Viewport -> Const Int Viewport
Lens' Viewport (Int, Int)
vpSize(((Int, Int) -> Const Int (Int, Int))
 -> Viewport -> Const Int Viewport)
-> ((Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int))
-> Getting Int Viewport Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Int -> Const Int Int) -> (Int, Int) -> Const Int (Int, Int)
forall s t a b. Field2 s t a b => Lens s t a b
_2) m -> m -> m
forall a. Fractional a => a -> a -> a
/
                                 Int -> m
forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericList n t e
theListGenericList n t e -> Getting Int (GenericList n t e) Int -> Int
forall s a. s -> Getting a s a -> a
^.Getting Int (GenericList n t e) Int
forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
listItemHeightL)
            GenericList n t e -> EventM n (GenericList n t e)
forall (m :: * -> *) a. Monad m => a -> m a
return (GenericList n t e -> EventM n (GenericList n t e))
-> GenericList n t e -> EventM n (GenericList n t e)
forall a b. (a -> b) -> a -> b
$ Int -> GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
nElems GenericList n t e
theList

-- | Move the list selected index.
--
-- If the current selection is @Just x@, the selection is adjusted by
-- the specified amount. The value is clamped to the extents of the list
-- (i.e. the selection does not "wrap").
--
-- If the current selection is @Nothing@ (i.e. there is no selection)
-- and the direction is positive, set to @Just 0@ (first element),
-- otherwise set to @Just (length - 1)@ (last element).
--
-- Complexity: same as 'splitAt' for the container type.
--
-- @
-- listMoveBy for 'List': O(1)
-- listMoveBy for 'Seq.Seq': O(log(min(i,n-i)))
-- @
listMoveBy :: (Foldable t, Splittable t)
           => Int
           -> GenericList n t e
           -> GenericList n t e
listMoveBy :: Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
amt GenericList n t e
l =
    let target :: Int
target = case GenericList n t e
l GenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
            Maybe Int
Nothing
                | Int
amt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Int
0
                | Bool
otherwise -> GenericList n t e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
            Just Int
i -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
amt Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i)  -- don't be negative
    in Int -> GenericList n t e -> GenericList n t e
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
target GenericList n t e
l

-- | Set the selected index for a list to the specified index, subject
-- to validation.
--
-- If @pos >= 0@, indexes from the start of the list (which gets
-- evaluated up to the target index)
--
-- If @pos < 0@, indexes from the end of the list (which evalutes
-- 'length' of the list).
--
-- Complexity: same as 'splitAt' for the container type.
--
-- @
-- listMoveTo for 'List': O(1)
-- listMoveTo for 'Seq.Seq': O(log(min(i,n-i)))
-- @
listMoveTo :: (Foldable t, Splittable t)
           => Int
           -> GenericList n t e
           -> GenericList n t e
listMoveTo :: Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
pos GenericList n t e
l =
    let len :: Int
len = GenericList n t e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l
        i :: Int
i = if Int
pos Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
pos else Int
pos
        newSel :: Int
newSel = GenericList n t e -> Int -> Int
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> Int -> Int
splitClamp GenericList n t e
l Int
i
    in GenericList n t e
l GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> GenericList n t e -> Identity (GenericList n t e))
-> Maybe Int -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ if GenericList n t e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null GenericList n t e
l then Maybe Int
forall a. Maybe a
Nothing else Int -> Maybe Int
forall a. a -> Maybe a
Just Int
newSel

-- | Split-based clamp that avoids evaluating 'length' of the structure
-- (unless the structure is already fully evaluated).
splitClamp :: (Foldable t, Splittable t) => GenericList n t e -> Int -> Int
splitClamp :: GenericList n t e -> Int -> Int
splitClamp GenericList n t e
l Int
i =
    let (t e
_, t e
t) = Int -> t e -> (t e, t e)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
i (GenericList n t e
l GenericList n t e -> Getting (t e) (GenericList n t e) (t e) -> t e
forall s a. s -> Getting a s a -> a
^. Getting (t e) (GenericList n t e) (t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL)  -- split at i
    in
        -- If the tail is empty, then the requested index is not in the
        -- list. And because we have already seen the end of the list,
        -- using 'length' will not force unwanted computation.
        --
        -- Otherwise if tail is not empty, then we already know that i
        -- is in the list, so we don't need to know the length
        Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 (if t e -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
t then GenericList n t e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 else Int
i) Int
i

-- | Set the selected index for a list to the index of the first
-- occurrence of the specified element if it is in the list, or leave
-- the list unmodified otherwise.
--
-- /O(n)/.  Only evaluates as much of the container as needed.
listMoveToElement :: (Eq e, Foldable t, Splittable t)
                  => e
                  -> GenericList n t e
                  -> GenericList n t e
listMoveToElement :: e -> GenericList n t e -> GenericList n t e
listMoveToElement e
e = (e -> Bool) -> GenericList n t e -> GenericList n t e
forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
listFindBy (e -> e -> Bool
forall a. Eq a => a -> a -> Bool
== e
e) (GenericList n t e -> GenericList n t e)
-> (GenericList n t e -> GenericList n t e)
-> GenericList n t e
-> GenericList n t e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASetter
  (GenericList n t e) (GenericList n t e) (Maybe Int) (Maybe Int)
-> Maybe Int -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (GenericList n t e) (GenericList n t e) (Maybe Int) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL Maybe Int
forall a. Maybe a
Nothing

-- | Starting from the currently-selected position, attempt to find
-- and select the next element matching the predicate. If there are no
-- matches for the remainder of the list or if the list has no selection
-- at all, the search starts at the beginning. If no matching element is
-- found anywhere in the list, leave the list unmodified.
--
-- /O(n)/.  Only evaluates as much of the container as needed.
listFindBy :: (Foldable t, Splittable t)
           => (e -> Bool)
           -> GenericList n t e
           -> GenericList n t e
listFindBy :: (e -> Bool) -> GenericList n t e -> GenericList n t e
listFindBy e -> Bool
test GenericList n t e
l =
    let start :: Int
start = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (GenericList n t e
l GenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL)
        (t e
h, t e
t) = Int -> t e -> (t e, t e)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
start (GenericList n t e
l GenericList n t e -> Getting (t e) (GenericList n t e) (t e) -> t e
forall s a. s -> Getting a s a -> a
^. Getting (t e) (GenericList n t e) (t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL)
        tailResult :: Maybe (Int, e)
tailResult = ((Int, e) -> Bool) -> [(Int, e)] -> Maybe (Int, e)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> Bool
test (e -> Bool) -> ((Int, e) -> e) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> e
forall a b. (a, b) -> b
snd) ([(Int, e)] -> Maybe (Int, e))
-> (t e -> [(Int, e)]) -> t e -> Maybe (Int, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [e] -> [(Int, e)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
start..] ([e] -> [(Int, e)]) -> (t e -> [e]) -> t e -> [(Int, e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (t e -> Maybe (Int, e)) -> t e -> Maybe (Int, e)
forall a b. (a -> b) -> a -> b
$ t e
t
        headResult :: Maybe (Int, e)
headResult = ((Int, e) -> Bool) -> [(Int, e)] -> Maybe (Int, e)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> Bool
test (e -> Bool) -> ((Int, e) -> e) -> (Int, e) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> e
forall a b. (a, b) -> b
snd) ([(Int, e)] -> Maybe (Int, e))
-> (t e -> [(Int, e)]) -> t e -> Maybe (Int, e)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> [e] -> [(Int, e)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] ([e] -> [(Int, e)]) -> (t e -> [e]) -> t e -> [(Int, e)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (t e -> Maybe (Int, e)) -> t e -> Maybe (Int, e)
forall a b. (a -> b) -> a -> b
$ t e
h
        result :: Maybe (Int, e)
result = Maybe (Int, e)
tailResult Maybe (Int, e) -> Maybe (Int, e) -> Maybe (Int, e)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, e)
headResult
    in (GenericList n t e -> GenericList n t e)
-> ((Int, e) -> GenericList n t e -> GenericList n t e)
-> Maybe (Int, e)
-> GenericList n t e
-> GenericList n t e
forall b a. b -> (a -> b) -> Maybe a -> b
maybe GenericList n t e -> GenericList n t e
forall a. a -> a
id (ASetter
  (GenericList n t e) (GenericList n t e) (Maybe Int) (Maybe Int)
-> Maybe Int -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter
  (GenericList n t e) (GenericList n t e) (Maybe Int) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL (Maybe Int -> GenericList n t e -> GenericList n t e)
-> ((Int, e) -> Maybe Int)
-> (Int, e)
-> GenericList n t e
-> GenericList n t e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> ((Int, e) -> Int) -> (Int, e) -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, e) -> Int
forall a b. (a, b) -> a
fst) Maybe (Int, e)
result GenericList n t e
l

-- | Return a list's selected element, if any.
--
-- Only evaluates as much of the container as needed.
--
-- Complexity: same as 'splitAt' for the container type.
--
-- @
-- listSelectedElement for 'List': O(1)
-- listSelectedElement for 'Seq.Seq': O(log(min(i, n - i)))
-- @
listSelectedElement :: (Splittable t, Foldable t)
                    => GenericList n t e
                    -> Maybe (Int, e)
listSelectedElement :: GenericList n t e -> Maybe (Int, e)
listSelectedElement GenericList n t e
l = do
    Int
sel <- GenericList n t e
lGenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^.Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL
    let (t e
_, t e
xs) = Int -> t e -> (t e, t e)
forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
sel (GenericList n t e
l GenericList n t e -> Getting (t e) (GenericList n t e) (t e) -> t e
forall s a. s -> Getting a s a -> a
^. Getting (t e) (GenericList n t e) (t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL)
    (Int
sel,) (e -> (Int, e)) -> Maybe e -> Maybe (Int, e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t e -> [e]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t e
xs [e] -> Getting (First e) [e] e -> Maybe e
forall s a. s -> Getting (First a) s a -> Maybe a
^? Getting (First e) [e] e
forall s a. Cons s s a a => Traversal' s a
_head

-- | Remove all elements from the list and clear the selection.
--
-- /O(1)/
listClear :: (Monoid (t e)) => GenericList n t e -> GenericList n t e
listClear :: GenericList n t e -> GenericList n t e
listClear GenericList n t e
l = GenericList n t e
l GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (t e -> Identity (t e))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL ((t e -> Identity (t e))
 -> GenericList n t e -> Identity (GenericList n t e))
-> t e -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ t e
forall a. Monoid a => a
mempty GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> GenericList n t e -> Identity (GenericList n t e))
-> Maybe Int -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Maybe Int
forall a. Maybe a
Nothing

-- | Reverse the list. The element selected before the reversal will
-- again be the selected one.
--
-- Complexity: same as 'reverse' for the container type.
--
-- @
-- listReverse for 'List': O(n)
-- listReverse for 'Seq.Seq': O(n)
-- @
listReverse :: (Reversible t, Foldable t)
            => GenericList n t e
            -> GenericList n t e
listReverse :: GenericList n t e -> GenericList n t e
listReverse GenericList n t e
l =
    GenericList n t e
l GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (t e -> Identity (t e))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL ((t e -> Identity (t e))
 -> GenericList n t e -> Identity (GenericList n t e))
-> (t e -> t e) -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ t e -> t e
forall (t :: * -> *) a. Reversible t => t a -> t a
reverse
      GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (Maybe Int -> Identity (Maybe Int))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL ((Maybe Int -> Identity (Maybe Int))
 -> GenericList n t e -> Identity (GenericList n t e))
-> (Maybe Int -> Maybe Int)
-> GenericList n t e
-> GenericList n t e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> Int) -> Maybe Int -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (GenericList n t e -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
-)

-- | Apply a function to the selected element. If no element is selected
-- the list is not modified.
--
-- Complexity: same as 'traverse' for the container type (typically
-- /O(n)/).
listModify :: (Traversable t)
           => (e -> e)
           -> GenericList n t e
           -> GenericList n t e
listModify :: (e -> e) -> GenericList n t e -> GenericList n t e
listModify e -> e
f GenericList n t e
l =
    case GenericList n t e
l GenericList n t e
-> Getting (Maybe Int) (GenericList n t e) (Maybe Int) -> Maybe Int
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Int) (GenericList n t e) (Maybe Int)
forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
        Maybe Int
Nothing -> GenericList n t e
l
        Just Int
j -> GenericList n t e
l GenericList n t e
-> (GenericList n t e -> GenericList n t e) -> GenericList n t e
forall a b. a -> (a -> b) -> b
& (t e -> Identity (t e))
-> GenericList n t e -> Identity (GenericList n t e)
forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL ((t e -> Identity (t e))
 -> GenericList n t e -> Identity (GenericList n t e))
-> (t e -> t e) -> GenericList n t e -> GenericList n t e
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (Int -> e -> e) -> t e -> t e
forall (t :: * -> *) a b.
Traversable t =>
(Int -> a -> b) -> t a -> t b
imap (\Int
i e
e -> if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
j then e -> e
f e
e else e
e)