{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
{-# 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
  , listSelectedElementL

  -- * 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 ((<|>))
import Data.Foldable (find, toList)
import Control.Monad.State (evalState)

import Lens.Micro (Traversal', (^.), (^?), (&), (.~), (%~), _2, 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 { forall n (t :: * -> *) e. GenericList n t e -> t e
listElements :: !(t e)
         -- ^ The list's sequence of elements.
         , forall n (t :: * -> *) e. GenericList n t e -> Maybe Int
listSelected :: !(Maybe Int)
         -- ^ The list's selected element index, if any.
         , forall n (t :: * -> *) e. GenericList n t e -> n
listName :: n
         -- ^ The list's name.
         , forall n (t :: * -> *) e. GenericList n t e -> Int
listItemHeight :: Int
         -- ^ The height of an individual item in the list.
         } deriving (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
<$ :: forall a b. 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 :: forall a b. (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, forall a. GenericList n t a -> Bool
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 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 :: forall a. Num a => GenericList n t a -> a
$cproduct :: forall n (t :: * -> *) a.
(Foldable t, Num a) =>
GenericList n t a -> a
sum :: forall a. Num a => GenericList n t a -> a
$csum :: forall n (t :: * -> *) a.
(Foldable t, Num a) =>
GenericList n t a -> a
minimum :: forall a. Ord a => GenericList n t a -> a
$cminimum :: forall n (t :: * -> *) a.
(Foldable t, Ord a) =>
GenericList n t a -> a
maximum :: forall a. Ord a => GenericList n t a -> a
$cmaximum :: forall n (t :: * -> *) a.
(Foldable t, Ord a) =>
GenericList n t a -> a
elem :: forall a. Eq a => a -> GenericList n t a -> Bool
$celem :: forall n (t :: * -> *) a.
(Foldable t, Eq a) =>
a -> GenericList n t a -> Bool
length :: forall a. GenericList n t a -> Int
$clength :: forall n (t :: * -> *) a. Foldable t => GenericList n t a -> Int
null :: forall a. GenericList n t a -> Bool
$cnull :: forall n (t :: * -> *) a. Foldable t => GenericList n t a -> Bool
toList :: forall a. GenericList n t a -> [a]
$ctoList :: forall n (t :: * -> *) a. Foldable t => GenericList n t a -> [a]
foldl1 :: forall a. (a -> a -> a) -> GenericList n t a -> a
$cfoldl1 :: forall n (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> GenericList n t a -> a
foldr1 :: forall a. (a -> a -> a) -> GenericList n t a -> a
$cfoldr1 :: forall n (t :: * -> *) a.
Foldable t =>
(a -> a -> a) -> GenericList n t a -> a
foldl' :: forall b a. (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 :: forall b a. (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' :: forall a b. (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 :: forall a b. (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' :: forall m a. Monoid m => (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 :: forall m a. Monoid m => (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 :: forall m. Monoid m => GenericList n t m -> m
$cfold :: forall n (t :: * -> *) m.
(Foldable t, Monoid m) =>
GenericList n t m -> m
Foldable, 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 (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> GenericList n t a -> f (GenericList n t b)
sequence :: forall (m :: * -> *) a.
Monad m =>
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 :: forall (m :: * -> *) a b.
Monad m =>
(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 :: forall (f :: * -> *) a.
Applicative f =>
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 :: forall (f :: * -> *) a b.
Applicative f =>
(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)
Traversable, Int -> GenericList n t e -> ShowS
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 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 = 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 = forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
i

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

-- | /O(log(min(i,n-i)))/ 'splitAt'.
instance Splittable Seq.Seq where
    splitAt :: forall a. Int -> Seq a -> (Seq a, Seq a)
splitAt = 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 :: forall a. Vector a -> Vector a
reverse = forall a. Vector a -> Vector a
V.reverse

-- | /O(n)/ 'reverse'
instance Reversible Seq.Seq where
  reverse :: forall a. Seq a -> Seq a
reverse = 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
                -> EventM n (GenericList n t e) ()
handleListEvent :: forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e =
    case Event
e of
        EvKey Key
KUp [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveUp
        EvKey Key
KDown [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown
        EvKey Key
KHome [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToBeginning
        EvKey Key
KEnd [] -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToEnd
        EvKey Key
KPageDown [] -> forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageDown
        EvKey Key
KPageUp [] -> forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageUp
        Event
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | 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 -> EventM n (GenericList n t e) ())
                  -- ^ Fallback event handler to use if none of the vi keys
                  -- match.
                  -> Event
                  -> EventM n (GenericList n t e) ()
handleListEventVi :: forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
(Event -> EventM n (GenericList n t e) ())
-> Event -> EventM n (GenericList n t e) ()
handleListEventVi Event -> EventM n (GenericList n t e) ()
fallback Event
e =
    case Event
e of
        EvKey (KChar Char
'k') []      -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveUp
        EvKey (KChar Char
'j') []      -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown
        EvKey (KChar Char
'g') []      -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToBeginning
        EvKey (KChar Char
'G') []      -> forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToEnd
        EvKey (KChar Char
'f') [Modifier
MCtrl] -> forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageDown
        EvKey (KChar Char
'b') [Modifier
MCtrl] -> forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageUp
        EvKey (KChar Char
'd') [Modifier
MCtrl] -> forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> EventM n (GenericList n t e) ()
listMoveByPages (Double
0.5::Double)
        EvKey (KChar Char
'u') [Modifier
MCtrl] -> forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> EventM n (GenericList n t e) ()
listMoveByPages (-Double
0.5::Double)
        Event
_                         -> Event -> EventM n (GenericList n t e) ()
fallback Event
e

-- | 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 :: forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToBeginning = 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 :: forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveToEnd GenericList n t e
l = forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo (forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall n (t :: * -> *) e. GenericList n t e -> t e
listElements GenericList n t e
l) forall a. Num a => a -> a -> a
- Int
1) GenericList n t e
l

-- | The top-level attribute used for the entire list.
listAttr :: AttrName
listAttr :: AttrName
listAttr = String -> AttrName
attrName String
"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 forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"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 forall a. Semigroup a => a -> a -> a
<> String -> AttrName
attrName String
"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 :: forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list n
name t e
es Int
h =
    let selIndex :: Maybe Int
selIndex = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
es then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Int
0
        safeHeight :: Int
safeHeight = forall a. Ord a => a -> a -> a
max Int
1 Int
h
    in 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 :: forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList Bool -> e -> Widget n
drawElem = 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 forall a b. (a -> b) -> a -> b
$ 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 :: 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
drawElem Bool
foc GenericList n t e
l =
    forall n. AttrName -> Widget n -> Widget n
withDefAttr AttrName
listAttr forall a b. (a -> b) -> a -> b
$
    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 :: forall (t :: * -> *) a b.
Traversable t =>
(Int -> a -> b) -> t a -> t b
imap Int -> a -> b
f t a
xs =
    let act :: StateT Int Identity (t b)
act = forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\a
a -> forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Int
i -> forall s (m :: * -> *). MonadState s m => s -> m ()
put (Int
i forall a. Num a => a -> a -> a
+ Int
1) forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> a -> b
f Int
i a
a) t a
xs
    in 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 :: 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 =
    forall n. Size -> Size -> RenderM n (Result n) -> Widget n
Widget Size
Greedy Size
Greedy forall a b. (a -> b) -> a -> b
$ do
        Context n
c <- forall n. RenderM n (Context n)
getContext

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

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

            start :: Int
start = forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$ Int
idx forall a. Num a => a -> a -> a
- Int
numPerHeight 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 n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL) forall a. Integral a => a -> a -> a
`div` (GenericList n t e
lforall s a. s -> Getting a s a -> a
^.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 forall a. Num a => a -> a -> a
+
                           if Int
initialNumPerHeight forall a. Num a => a -> a -> a
* (GenericList n t e
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
listItemHeightL) forall a. Eq a => a -> a -> Bool
== Context n
cforall s a. s -> Getting a s a -> a
^.forall n. Lens' (Context n) Int
availHeightL
                           then Int
0
                           else Int
1

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

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

        forall n. Widget n -> RenderM n (Result n)
render forall a b. (a -> b) -> a -> b
$ forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport (GenericList n t e
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e n.
Lens (GenericList n t e) (GenericList n t e) n n
listNameL) ViewportType
Vertical forall a b. (a -> b) -> a -> b
$
                 forall n. Location -> Widget n -> Widget n
translateBy ((Int, Int) -> Location
Location (Int
0, Int
off)) forall a b. (a -> b) -> a -> b
$
                 forall n. [Widget n] -> Widget n
vBox forall a b. (a -> b) -> a -> b
$ 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 :: forall (t :: * -> *) e n.
(Splittable t, Applicative t, Semigroup (t e)) =>
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
lforall s a. s -> Getting a s a -> a
^.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
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
            Maybe Int
Nothing -> Int
0
            Just Int
s -> if Int
pos forall a. Ord a => a -> a -> Bool
<= Int
s
                      then Int
s forall a. Num a => a -> a -> a
+ Int
1
                      else Int
s
        (t e
front, t e
back) = forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
pos t e
es
    in GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just Int
newSel
         forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Semigroup a => NonEmpty a -> a
sconcat (t e
front forall a. a -> [a] -> NonEmpty a
:| [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 :: forall (t :: * -> *) e n.
(Splittable t, Foldable t, Semigroup (t e)) =>
Int -> GenericList n t e -> GenericList n t e
listRemove Int
pos GenericList n t e
l | forall (t :: * -> *) a. Foldable t => t a -> Bool
null GenericList n t e
l = GenericList n t e
l
                 | Int
pos forall a. Eq a => a -> a -> Bool
/= 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
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
            Maybe Int
Nothing -> Int
0
            Just Int
s | Int
pos forall a. Eq a => a -> a -> Bool
== Int
0 -> Int
0
                   | Int
pos forall a. Eq a => a -> a -> Bool
== Int
s -> Int
pos forall a. Num a => a -> a -> a
- Int
1
                   | Int
pos  forall a. Ord a => a -> a -> Bool
< Int
s -> Int
s forall a. Num a => a -> a -> a
- Int
1
                   | Bool
otherwise -> Int
s
        (t e
front, t e
rest) = forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
pos t e
es
        (t e
_, t e
back) = 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 forall a. Semigroup a => a -> a -> a
<> t e
back
        es :: t e
es = GenericList n t e
lforall s a. s -> Getting a s a -> a
^.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 forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
es' then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just Int
newSel)
         forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL 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 :: forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
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 forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ t e
es
        newSel :: Maybe Int
newSel = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
es then forall a. Maybe a
Nothing else Int -> Int
inBoundsOrZero forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Int
idx
        inBoundsOrZero :: Int -> Int
inBoundsOrZero Int
i
            | Int
i forall a. Eq a => a -> a -> Bool
== 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' forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL 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 :: forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveUp = 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)
               => EventM n (GenericList n t e) ()
listMovePageUp :: forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageUp = forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> 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 :: forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> GenericList n t e
listMoveDown = 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)
                 => EventM n (GenericList n t e) ()
listMovePageDown :: forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
EventM n (GenericList n t e) ()
listMovePageDown = forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> 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
                -> EventM n (GenericList n t e) ()
listMoveByPages :: forall (t :: * -> *) n m e.
(Foldable t, Splittable t, Ord n, RealFrac m) =>
m -> EventM n (GenericList n t e) ()
listMoveByPages m
pages = do
    GenericList n t e
theList <- forall s (m :: * -> *). MonadState s m => m s
get
    Maybe Viewport
v <- forall n s. Ord n => n -> EventM n s (Maybe Viewport)
lookupViewport (GenericList n t e
theListforall s a. s -> Getting a s a -> a
^.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 -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Viewport
vp -> do
            let nElems :: Int
nElems = forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ m
pages forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (Viewport
vpforall s a. s -> Getting a s a -> a
^.Lens' Viewport (Int, Int)
vpSizeforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall s t a b. Field2 s t a b => Lens s t a b
_2) forall a. Fractional a => a -> a -> a
/
                                 forall a b. (Integral a, Num b) => a -> b
fromIntegral (GenericList n t e
theListforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) Int
listItemHeightL)
            forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveBy Int
nElems

-- | 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 :: forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
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 forall s a. s -> Getting a s a -> a
^. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
            Maybe Int
Nothing
                | Int
amt forall a. Ord a => a -> a -> Bool
> Int
0 -> Int
0
                | Bool
otherwise -> forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l forall a. Num a => a -> a -> a
- Int
1
            Just Int
i -> forall a. Ord a => a -> a -> a
max Int
0 (Int
amt forall a. Num a => a -> a -> a
+ Int
i)  -- don't be negative
    in 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 evaluates
-- '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 :: forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
listMoveTo Int
pos GenericList n t e
l =
    let len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l
        i :: Int
i = if Int
pos forall a. Ord a => a -> a -> Bool
< Int
0 then Int
len forall a. Num a => a -> a -> a
- Int
pos else Int
pos
        newSel :: Int
newSel = 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 forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL forall s t a b. ASetter s t a b -> b -> s -> t
.~ if forall (t :: * -> *) a. Foldable t => t a -> Bool
null GenericList n t e
l then forall a. Maybe a
Nothing else 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 :: forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
GenericList n t e -> Int -> Int
splitClamp GenericList n t e
l Int
i =
    let (t e
_, t e
t) = forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
i (GenericList n t e
l forall s a. s -> Getting a s a -> a
^. 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
        forall a. Ord a => a -> a -> a -> a
clamp Int
0 (if forall (t :: * -> *) a. Foldable t => t a -> Bool
null t e
t then forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l 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 :: forall e (t :: * -> *) n.
(Eq e, Foldable t, Splittable t) =>
e -> GenericList n t e -> GenericList n t e
listMoveToElement e
e = forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
listFindBy (forall a. Eq a => a -> a -> Bool
== e
e) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s t a b. ASetter s t a b -> b -> s -> t
set forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL 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 :: forall (t :: * -> *) e n.
(Foldable t, Splittable t) =>
(e -> Bool) -> GenericList n t e -> GenericList n t e
listFindBy e -> Bool
test GenericList n t e
l =
    let start :: Int
start = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 (forall a. Num a => a -> a -> a
+Int
1) (GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL)
        (t e
h, t e
t) = forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
start (GenericList n t e
l forall s a. s -> Getting a s a -> a
^. 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 = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
start..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ t e
t
        headResult :: Maybe (Int, e)
headResult = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (e -> Bool
test forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall a b. (a -> b) -> a -> b
$ t e
h
        result :: Maybe (Int, e)
result = Maybe (Int, e)
tailResult forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe (Int, e)
headResult
    in forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall s t a b. ASetter s t a b -> b -> s -> t
set forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) Maybe (Int, e)
result GenericList n t e
l

-- | Traversal that targets the selected element, if any.
--
-- Complexity: depends on usage as well as the list's container type.
--
-- @
-- listSelectedElementL for 'List': O(1) -- preview, fold
--                                O(n) -- set, modify, traverse
-- listSelectedElementL for 'Seq.Seq': O(log(min(i, n - i)))  -- all operations
-- @
--
listSelectedElementL :: (Splittable t, Traversable t, Semigroup (t e))
                     => Traversal' (GenericList n t e) e
listSelectedElementL :: forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
Traversal' (GenericList n t e) e
listSelectedElementL e -> f e
f GenericList n t e
l =
    case GenericList n t e
l forall s a. s -> Getting a s a -> a
^. forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL of
        Maybe Int
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure GenericList n t e
l
        Just Int
i -> forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL forall {t :: * -> *}.
(Semigroup (t e), Traversable t, Splittable t) =>
t e -> f (t e)
go GenericList n t e
l
            where
                go :: t e -> f (t e)
go t e
l' = let (t e
left, t e
rest) = forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
i t e
l'
                            -- middle contains the target element (if any)
                            (t e
middle, t e
right) = forall (t :: * -> *) a. Splittable t => Int -> t a -> (t a, t a)
splitAt Int
1 t e
rest
                        in (\t e
m -> t e
left forall a. Semigroup a => a -> a -> a
<> t e
m forall a. Semigroup a => a -> a -> a
<> t e
right) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse e -> f e
f t e
middle)

-- | 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, Traversable t, Semigroup (t e))
                    => GenericList n t e
                    -> Maybe (Int, e)
listSelectedElement :: forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement GenericList n t e
l =
    (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericList n t e
lforall s a. s -> Getting a s a -> a
^.forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> GenericList n t e
lforall s a. s -> Getting (First a) s a -> Maybe a
^?forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
Traversal' (GenericList n t e) e
listSelectedElementL

-- | 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 :: forall (t :: * -> *) e n.
Monoid (t e) =>
GenericList n t e -> GenericList n t e
listClear GenericList n t e
l = GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. Monoid a => a
mempty forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL forall s t a b. ASetter s t a b -> b -> s -> t
.~ 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 :: forall (t :: * -> *) n e.
(Reversible t, Foldable t) =>
GenericList n t e -> GenericList n t e
listReverse GenericList n t e
l =
    GenericList n t e
l forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e (t :: * -> *) e.
Lens (GenericList n t e) (GenericList n t e) (t e) (t e)
listElementsL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (t :: * -> *) a. Reversible t => t a -> t a
reverse
      forall a b. a -> (a -> b) -> b
& forall n (t :: * -> *) e. Lens' (GenericList n t e) (Maybe Int)
listSelectedL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (t :: * -> *) a. Foldable t => t a -> Int
length GenericList n t e
l forall a. Num a => a -> a -> a
- Int
1 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)/).
--
-- Complexity: same as 'listSelectedElementL' for the list's container type.
--
-- @
-- listModify for 'List': O(n)
-- listModify for 'Seq.Seq': O(log(min(i, n - i)))
-- @
--
listModify :: (Traversable t, Splittable t, Semigroup (t e))
           => (e -> e)
           -> GenericList n t e
           -> GenericList n t e
listModify :: forall (t :: * -> *) e n.
(Traversable t, Splittable t, Semigroup (t e)) =>
(e -> e) -> GenericList n t e -> GenericList n t e
listModify e -> e
f = forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
Traversal' (GenericList n t e) e
listSelectedElementL forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ e -> e
f