brick 0.43 → 0.44

raw patch · 5 files changed

+737/−143 lines, 5 filesdep ~containersdep ~microlensPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: containers, microlens

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• brick.cabal +7/−2
• src/Brick/Widgets/List.hs +364/−140
• tests/List.hs +346/−0
• tests/Main.hs +6/−1

@@ -2,6 +2,20 @@ Brick changelog --------------- +0.44+---++API changes:+ * The `List` type got its container type generalized thanks to a lot of+   work by Fraser Tweedale. Thanks to this work, the `List` now supports+   both `Data.Vector` and `Data.Sequence` as its container types out of+   the box and can be extended to support other sequence types with some+   simple type class instances. In addition, property tests are provided+   for `List` and its asymptotics are noted in the documentation. Along+   the way, various bugs in some of the list movement functions got+   fixed to bring them in line with the advertised behavior in the+   documentation. Thanks, Fraser!+ 0.43 ---- 

@@ -1,5 +1,5 @@ name:                brick-version:             0.43+version:             0.44 synopsis:            A declarative terminal user interface library description:   Write terminal applications painlessly with 'brick'! You write an@@ -94,7 +94,7 @@                        directory >= 1.2.5.0,                        dlist,                        filepath,-                       containers,+                       containers >= 0.5.7,                        microlens >= 0.3.0.0,                        microlens-th,                        microlens-mtl,@@ -448,7 +448,12 @@     ghc-options:       -Wno-orphans   default-language:    Haskell2010   main-is:             Main.hs+  other-modules:       List   build-depends:       base <=5,                        brick,                        containers,+                       microlens,+                       vector,                        QuickCheck+  if impl(ghc < 8.0)+    build-depends:     semigroups

@@ -10,7 +10,8 @@ -- | This module provides a scrollable list type and functions for -- manipulating and rendering it. module Brick.Widgets.List-  ( List+  ( GenericList+  , List    -- * Constructing a list   , list@@ -56,19 +57,31 @@   , listAttr   , listSelectedAttr   , listSelectedFocusedAttr++  -- * Classes+  , Splittable(..)+  , Reversible(..)   ) where +import Prelude hiding (reverse, splitAt)+ #if !MIN_VERSION_base(4,8,0)-import Control.Applicative ((<$>),(<*>),pure)-import Data.Foldable (Foldable)+import Control.Applicative ((<$>), (<*>), pure, (<|>))+import Data.Foldable (Foldable, find, toList) import Data.Traversable (Traversable)-#endif+#else import Control.Applicative ((<|>))+import Data.Foldable (find, toList)+#endif+import Control.Monad.Trans.State (evalState, get, put) -import Lens.Micro ((^.), (&), (.~), (%~), _2)+import Lens.Micro ((^.), (^?), (&), (.~), (%~), _2, _head)+import Data.Functor (($>))+import Data.List.NonEmpty (NonEmpty((:|))) import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))+import Data.Semigroup (Semigroup, (<>), sconcat)+import qualified Data.Sequence as Seq import Graphics.Vty (Event(..), Key(..), Modifier(..)) import qualified Data.Vector as V import GHC.Generics (Generic)@@ -79,67 +92,137 @@ import Brick.Util (clamp) import Brick.AttrMap --- | List state. Lists have an element type 'e' that is the data stored--- by the list.  Lists handle the following events by default:+-- | 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-data List n e =-    List { listElements :: !(V.Vector e)-         -- ^ The list's vector of elements.+--+-- 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 { listElements :: !(t e)+         -- ^ The list's sequence of elements.          , listSelected :: !(Maybe Int)          -- ^ The list's selected element index, if any.          , listName :: n          -- ^ The list's name.          , listItemHeight :: Int-         -- ^ The height of the list items.+         -- ^ The height of an individual item in the list.          } deriving (Functor, Foldable, Traversable, Show, Generic) -suffixLenses ''List+suffixLenses ''GenericList -instance Named (List n e) n where+-- | 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 = listName -handleListEvent :: (Ord n) => Event -> List n e -> EventM n (List n e)+-- | 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 i n = fst . splitAt n . snd . splitAt i++-- | /O(1)/ 'splitAt'.+instance Splittable V.Vector where+    splitAt = V.splitAt++-- | /O(log(min(i,n-i)))/ 'splitAt'.+instance Splittable Seq.Seq where+    splitAt = 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 = V.reverse++-- | /O(n)/ 'reverse'+instance Reversible Seq.Seq where+  reverse = 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 e theList =     case e of         EvKey KUp [] -> return $ listMoveUp theList         EvKey KDown [] -> return $ listMoveDown theList         EvKey KHome [] -> return $ listMoveTo 0 theList-        EvKey KEnd [] -> return $ listMoveTo (V.length $ listElements theList) theList+        EvKey KEnd [] -> return $ listMoveTo (length $ listElements theList) theList         EvKey KPageDown [] -> listMovePageDown theList         EvKey KPageUp [] -> listMovePageUp theList         _ -> return theList --- | Enable list movement with the vi keys with a fallback if none--- match. Use (handleListEventVi handleListEvent) in place of--- handleListEvent to add the vi keys bindings to the standard ones.+-- | 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)+-- * Up (k)+-- * Down (j)+-- * Page Up (Ctrl-b)+-- * Page Down (Ctrl-f)+-- * Half Page Up (Ctrl-u) -- * Half Page Down (Ctrl-d)--- * Top            (g)--- * Bottom         (G)-handleListEventVi :: (Ord n)-                  => (Event -> List n e -> EventM n (List n e))+-- * 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-                  -> List n e-                  -> EventM n (List n e)+                  -> GenericList n t e+                  -> EventM n (GenericList n t e) handleListEventVi fallback e theList =     case e of         EvKey (KChar 'k') [] -> return $ listMoveUp theList         EvKey (KChar 'j') [] -> return $ listMoveDown theList         EvKey (KChar 'g') [] -> return $ listMoveTo 0 theList-        EvKey (KChar 'G') [] -> return $ listMoveTo (V.length $ listElements theList) theList+        EvKey (KChar 'G') [] -> return $ listMoveTo (length $ listElements theList) theList         EvKey (KChar 'f') [MCtrl] -> listMovePageDown theList         EvKey (KChar 'b') [MCtrl] -> listMovePageUp theList         EvKey (KChar 'd') [MCtrl] -> listMoveByPages (0.5::Double) theList@@ -160,65 +243,87 @@ listSelectedFocusedAttr :: AttrName listSelectedFocusedAttr = listSelectedAttr <> "focused" --- | Construct a list in terms of an element type 'e'.-list :: n+-- | Construct a list in terms of container 't' with element type 'e'.+list :: (Foldable t)+     => n      -- ^ The list name (must be unique)-     -> V.Vector e+     -> t e      -- ^ The initial list contents      -> Int      -- ^ The list item height in rows (all list item widgets must be-     -- this high)-     -> List n e+     -- this high).+     -> GenericList n t e list name es h =-    let selIndex = if V.null es then Nothing else Just 0+    let selIndex = if null es then Nothing else Just 0         safeHeight = max 1 h     in List es selIndex name safeHeight --- | Turn a list state value into a widget given an item drawing--- function.-renderList :: (Ord n, Show n)+-- | 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.+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-           -> List n e+           -> GenericList n t e            -- ^ The List to be rendered            -> Widget n            -- ^ rendered widget renderList drawElem = renderListWithIndex $ const drawElem --- | Like 'renderList', except the render function is also provided--- with the index of each element.-renderListWithIndex :: (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-           -> List n e-           -- ^ The List to be rendered-           -> Widget n-           -- ^ rendered widget+-- | 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 drawElem foc l =     withDefAttr listAttr $     drawListElements foc l drawElem -drawListElements :: (Ord n, Show n) => Bool -> List n e -> (Int -> Bool -> e -> Widget n) -> Widget n+imap :: (Traversable t) => (Int -> a -> b) -> t a -> t b+imap f xs =+    let act = traverse (\a -> get >>= \i -> put (i + 1) $> f i a) xs+    in evalState act 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 foc l drawElem =     Widget Greedy Greedy $ do         c <- getContext -        let es = if num <= 0-                 then V.empty-                 else V.slice start num (l^.listElementsL)+        -- Take (numPerHeight * 2) elements, or whatever is left+        let es = slice start (numPerHeight * 2) (l^.listElementsL)              idx = fromMaybe 0 (l^.listSelectedL)              start = max 0 $ idx - numPerHeight + 1-            num = min (numPerHeight * 2) (V.length (l^.listElementsL) - start) -            -- The number of items to show is the available height divided by-            -- the item height...+            -- The number of items to show is the available height+            -- divided by the item height...             initialNumPerHeight = (c^.availHeightL) `div` (l^.listItemHeightL)             -- ... but if the available height leaves a remainder of             -- an item height then we need to ensure that we render an@@ -235,7 +340,7 @@              off = start * (l^.listItemHeightL) -            drawnElements = flip V.imap es $ \i e ->+            drawnElements = flip imap es $ \i e ->                 let j = i + start                     isSelected = Just j == l^.listSelectedL                     elemWidget = drawElem j isSelected e@@ -249,141 +354,260 @@          render $ viewport (l^.listNameL) Vertical $                  translateBy (Location (0, off)) $-                 vBox $ V.toList drawnElements+                 vBox $ toList drawnElements  -- | Insert an item into a list at the specified position.-listInsert :: Int+--+-- 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-           -> List n e-           -> List n e+           -> GenericList n t e+           -> GenericList n t e listInsert pos e l =-    let safePos = clamp 0 (V.length es) pos-        es = l^.listElementsL+    let es = l^.listElementsL         newSel = case l^.listSelectedL of-          Nothing -> 0-          Just s -> if safePos <= s-                    then s + 1-                    else s-        (front, back) = V.splitAt safePos es+            Nothing -> 0+            Just s -> if pos <= s+                      then s + 1+                      else s+        (front, back) = splitAt pos es     in l & listSelectedL .~ Just newSel-         & listElementsL .~ (front V.++ (e `V.cons` back))+         & listElementsL .~ sconcat (front :| [pure e, back])  -- | Remove an element from a list at the specified position.-listRemove :: Int-           -- ^ The position at which to remove an element (0 <= i < size)-           -> List n e-           -> List n e-listRemove pos l | V.null (l^.listElementsL) = l-                 | pos /= clamp 0 (V.length (l^.listElementsL) - 1) pos = l+--+-- 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 pos l | null (l^.listElementsL) = l+                 | pos /= splitClamp l pos = l                  | otherwise =     let newSel = case l^.listSelectedL of-          Nothing -> 0-          Just s | pos == 0 -> 0-                 | pos == s -> pos - 1-                 | pos  < s -> s - 1-                 | otherwise -> s-        (front, back) = V.splitAt pos es-        es' = front V.++ V.tail back+            Nothing -> 0+            Just s | pos == 0 -> 0+                   | pos == s -> pos - 1+                   | pos  < s -> s - 1+                   | otherwise -> s+        (front, rest) = splitAt pos es+        (_, back) = splitAt 1 rest+        es' = front <> back         es = l^.listElementsL-    in l & listSelectedL .~ (if V.null es' then Nothing else Just newSel)+    in l & listSelectedL .~ (if null es' then Nothing else Just newSel)          & listElementsL .~ 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.-listReplace :: V.Vector e -> Maybe Int -> List n e -> List n e+-- 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 es idx l =-    let newSel = if V.null es then Nothing else clamp 0 (V.length es - 1) <$> idx-    in l & listSelectedL .~ newSel-         & listElementsL .~ es+    let l' = l & listElementsL .~ es+        newSel = if null es then Nothing else inBoundsOrZero <$> idx+        inBoundsOrZero i+            | i == splitClamp l' i = i+            | otherwise = 0+    in l' & listSelectedL .~ newSel  -- | Move the list selected index up by one. (Moves the cursor up, -- subtracts one from the index.)-listMoveUp :: List n e -> List n e+listMoveUp :: (Foldable t, Splittable t)+           => GenericList n t e+           -> GenericList n t e listMoveUp = listMoveBy (-1)  -- | Move the list selected index up by one page.-listMovePageUp :: (Ord n) => List n e -> EventM n (List n e)-listMovePageUp theList = listMoveByPages (-1::Double) theList+listMovePageUp+  :: (Foldable t, Splittable t, Ord n)+  => GenericList n t e -> EventM n (GenericList n t e)+listMovePageUp = listMoveByPages (-1::Double)  -- | Move the list selected index down by one. (Moves the cursor down, -- adds one to the index.)-listMoveDown :: List n e -> List n e+listMoveDown :: (Foldable t, Splittable t)+             => GenericList n t e+             -> GenericList n t e listMoveDown = listMoveBy 1  -- | Move the list selected index down by one page.-listMovePageDown :: (Ord n) => List n e -> EventM n (List n e)-listMovePageDown theList = listMoveByPages (1::Double) theList+listMovePageDown :: (Foldable t, Splittable t, Ord n)+                 => GenericList n t e+                 -> EventM n (GenericList n t e)+listMovePageDown = listMoveByPages (1::Double)  -- | Move the list selected index by some (fractional) number of pages.-listMoveByPages :: (Ord n, RealFrac m) => m -> List n e -> EventM n (List n e)+listMoveByPages :: (Foldable t, Splittable t, Ord n, RealFrac m)+                => m+                -> GenericList n t e+                -> EventM n (GenericList n t e) listMoveByPages pages theList = do     v <- lookupViewport (theList^.listNameL)     case v of         Nothing -> return theList-        Just vp -> let-            nElems = round $ pages * (fromIntegral $ vp^.vpSize._2) / (fromIntegral $ theList^.listItemHeightL)-          in+        Just vp -> do+            let nElems = round $ pages * fromIntegral (vp^.vpSize._2) /+                                 fromIntegral (theList^.listItemHeightL)             return $ listMoveBy nElems theList --- | Move the list selected index. If the index is `Just x`, adjust by the--- specified amount; if it 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). Subject to validation.-listMoveBy :: Int -> List n e -> List n e+-- | 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 amt l =-    let current = case l^.listSelectedL of-          Nothing-            | amt > 0 -> Just 0-            | otherwise -> Just (V.length (l^.listElementsL) - 1)-          cur -> cur-        clamp' a b c-          | a <= b = Just (clamp a b c)-          | otherwise = Nothing-        newSel = clamp' 0 (V.length (l^.listElementsL) - 1) =<< (amt +) <$> current-    in l & listSelectedL .~ newSel+    let target = case l ^. listSelectedL of+            Nothing+                | amt > 0 -> 0+                | otherwise -> length (l ^. listElementsL) - 1+            Just i -> max 0 (amt + i)  -- don't be negative+    in listMoveTo target l  -- | Set the selected index for a list to the specified index, subject -- to validation.-listMoveTo :: Int -> List n e -> List n e+--+-- 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 pos l =-    let len = V.length (l^.listElementsL)-        newSel = clamp 0 (len - 1) $ if pos < 0 then len - pos else pos-    in l & listSelectedL .~ if len > 0+    let len = length (l ^. listElementsL)+        i = if pos < 0 then len - pos else pos+        newSel = splitClamp l i+    in l & listSelectedL .~ if not (null (l ^. listElementsL))                             then Just newSel                             else Nothing +-- | 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 l i =+    let (_, t) = splitAt i (l ^. 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+        clamp 0 (if null t then length (l ^. listElementsL) - 1 else i) i+ -- | Set the selected index for a list to the index of the specified -- element if it is in the list, or leave the list unmodified otherwise.-listMoveToElement :: (Eq e) => e -> List n e -> List n e+--+-- Complexity: same as 'traverse' for the container type (typically+-- /O(n)/).+listMoveToElement :: (Eq e, Traversable t)+                  => e+                  -> GenericList n t e+                  -> GenericList n t e listMoveToElement e l =-    let i = V.elemIndex e (l^.listElementsL)+    let i = fmap fst $ find ((== e) . snd) $ imap (,) (l^.listElementsL)     in l & listSelectedL %~ (i <|>)  -- | Return a list's selected element, if any.-listSelectedElement :: List n e -> Maybe (Int, e)+--+-- 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 l = do-  sel <- l^.listSelectedL-  return (sel, (l^.listElementsL) V.! sel)+    sel <- l^.listSelectedL+    let (_, xs) = splitAt sel (l ^. listElementsL)+    (sel,) <$> toList xs ^? _head  -- | Remove all elements from the list and clear the selection.-listClear :: List n e -> List n e-listClear l = l & listElementsL .~ V.empty & listSelectedL .~ Nothing+--+-- /O(1)/+listClear :: (Monoid (t e)) => GenericList n t e -> GenericList n t e+listClear l = l & listElementsL .~ mempty & listSelectedL .~ Nothing --- | Reverse the list.  The element selected before the reversal will+-- | Reverse the list. The element selected before the reversal will -- again be the selected one.-listReverse :: List n e -> List n e-listReverse theList = theList & listElementsL %~ V.reverse & listSelectedL .~ newSel-  where n = V.length (listElements theList)-        newSel = (-) <$> pure (n-1) <*> listSelected theList+--+-- 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 l =+    l & listElementsL %~ reverse+      & listSelectedL %~ fmap (length (l ^. listElementsL) - 1 -)  -- | Apply a function to the selected element. If no element is selected -- the list is not modified.-listModify :: (e -> e) -> List n e -> List n e-listModify f l = case listSelectedElement l of-  Nothing -> l-  Just (n,e) -> let es = V.update (l^.listElementsL) (return (n, f e))-                in listReplace es (Just n) l+--+-- 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 f l =+    case l ^. listSelectedL of+        Nothing -> l+        Just j -> l & listElementsL %~ imap (\i e -> if i == j then f e else e)

@@ -0,0 +1,346 @@+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeSynonymInstances #-}++module List+  (+    main+  ) where++import Prelude hiding (reverse, splitAt)++import Data.Function (on)+import qualified Data.List+import Data.Maybe (isNothing)+import Data.Monoid (Endo(..))+import Data.Proxy+import Data.Semigroup (Semigroup((<>)))++import qualified Data.Sequence as Seq+import qualified Data.Vector as V+import Lens.Micro+import Test.QuickCheck++import Brick.Util (clamp)+import Brick.Widgets.List++instance (Arbitrary n, Arbitrary a) => Arbitrary (List n a) where+  arbitrary = list <$> arbitrary <*> (V.fromList <$> arbitrary) <*> pure 1+++-- List move operations that never modify the underlying list+data ListMoveOp a+  = MoveUp+  | MoveDown+  | MoveBy Int+  | MoveTo Int+  | MoveToElement a+  deriving (Show)++instance Arbitrary a => Arbitrary (ListMoveOp a) where+  arbitrary = oneof+    [ pure MoveUp+    , pure MoveDown+    , MoveBy <$> arbitrary+    , MoveTo <$> arbitrary+    , MoveToElement <$> arbitrary+    ]++-- List operations.  We don't have "page"-based movement operations+-- because these depend on render context (i.e. effect in EventM)+data ListOp a+  = Insert Int a+  | Remove Int+  | Replace Int [a]+  | Clear+  | Reverse+  | ListMoveOp (ListMoveOp a)+  deriving (Show)++instance Arbitrary a => Arbitrary (ListOp a) where+  arbitrary = frequency+    [ (1, Insert <$> arbitrary <*> arbitrary)+    , (1, Remove <$> arbitrary)+    , (1, Replace <$> arbitrary <*> arbitrary)+    , (1, pure Clear)+    , (1, pure Reverse)+    , (5, arbitrary)+    ]++-- Turn a ListOp into a List endomorphism+op :: Eq a => ListOp a -> List n a -> List n a+op (Insert i a) = listInsert i a+op (Remove i) = listRemove i+op (Replace i xs) =+  -- avoid setting index to Nothing+  listReplace (V.fromList xs) (Just i)+op Clear = listClear+op Reverse = listReverse+op (ListMoveOp mo) = moveOp mo++-- Turn a ListMoveOp into a List endomorphism+moveOp :: (Eq a) => ListMoveOp a -> List n a -> List n a+moveOp MoveUp = listMoveUp+moveOp MoveDown = listMoveDown+moveOp (MoveBy n) = listMoveBy n+moveOp (MoveTo n) = listMoveTo n+moveOp (MoveToElement a) = listMoveToElement a++applyListOps+  :: (Foldable t)+  => (op a -> List n a -> List n a) -> t (op a) -> List n a -> List n a+applyListOps f = appEndo . foldMap (Endo . f)++-- list operations keep the selected index in bounds+prop_listOpsMaintainSelectedValid+  :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_listOpsMaintainSelectedValid ops l =+  let l' = applyListOps op ops l+  in+    case l' ^. listSelectedL of+      -- either there is no selection and list is empty+      Nothing -> null (l' ^. listElementsL)+      -- or the selected index is valid+      Just i -> i >= 0 && i < length (l' ^. listElementsL)++-- reversing a list keeps the selected element the same+prop_reverseMaintainsSelectedElement+  :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_reverseMaintainsSelectedElement ops l =+  let+    -- apply some random list ops to (probably) set a selected element+    l' = applyListOps op ops l+    l'' = listReverse l'+  in+    fmap snd (listSelectedElement l') == fmap snd (listSelectedElement l'')++-- reversing maintains size of list+prop_reverseMaintainsSizeOfList :: List n a -> Bool+prop_reverseMaintainsSizeOfList l =+  length (l ^. listElementsL) == length (listReverse l ^. listElementsL)++-- an inserted element may always be found at the given index+-- (when target index is clamped to 0 <= n <= len)+prop_insert :: (Eq a) => Int -> a -> List n a -> Bool+prop_insert i a l =+  let+    l' = listInsert i a l+    i' = clamp 0 (length (l ^. listElementsL)) i+  in+    listSelectedElement (listMoveTo i' l') == Just (i', a)++-- inserting anywhere always increases size of list by 1+prop_insertSize :: (Eq a) => Int -> a -> List n a -> Bool+prop_insertSize i a l =+  let+    l' = listInsert i a l+  in+    length (l' ^. listElementsL) == length (l ^. listElementsL) + 1++-- inserting an element and moving to it always succeeds and+-- the selected element is the one we inserted.+--+-- The index is not necessarily the index we inserted at, because+-- the element could be present in the original list.  So we don't+-- check that.+--+prop_insertMoveTo :: (Eq a) => [ListOp a] -> List n a -> Int -> a -> Bool+prop_insertMoveTo ops l i a =+  let+    l' = listInsert i a (applyListOps op ops l)+    sel = listSelectedElement (listMoveToElement a l')+  in+    fmap snd sel == Just a++-- inserting then deleting always yields a list with the original elems+prop_insertRemove :: (Eq a) => Int -> a -> List n a -> Bool+prop_insertRemove i a l =+  let+    i' = clamp 0 (length (l ^. listElementsL)) i+    l' = listInsert i' a l -- pre-clamped+    l'' = listRemove i' l'+  in+    l'' ^. listElementsL == l ^. listElementsL++-- deleting in-bounds always reduces size of list by 1+-- deleting out-of-bounds never changes list size+prop_remove :: Int -> List n a -> Bool+prop_remove i l =+  let+    len = length (l ^. listElementsL)+    i' = clamp 0 (len - 1) i+    test+      | len > 0 && i == i' = (== len - 1)  -- i is in bounds+      | otherwise = (== len)               -- i is out of bounds+  in+    test (length (listRemove i l ^. listElementsL))++-- deleting an element and re-inserting it at same position+-- gives the original list elements+prop_removeInsert :: (Eq a) => Int -> List n a -> Bool+prop_removeInsert i l =+  let+    sel = listSelectedElement (listMoveTo i l)+    l' = maybe id (\(i', a) -> listInsert i' a . listRemove i') sel l+  in+    l' ^. listElementsL == l ^. listElementsL++converge :: (a -> a -> Bool) -> (a -> a) -> a -> a+converge test f a+  | test (f a) a = a+  | otherwise = converge test f (f a)++-- listMoveUp always reaches 0 (or list is empty)+prop_moveUp :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_moveUp ops l =+  let+    l' = applyListOps op ops l+    l'' = converge ((==) `on` (^. listSelectedL)) listMoveUp l'+    len = length (l'' ^. listElementsL)+  in+    maybe (len == 0) (== 0) (l'' ^. listSelectedL)++-- listMoveDown always reaches end of list (or list is empty)+prop_moveDown :: (Eq a) => [ListOp a] -> List n a -> Bool+prop_moveDown ops l =+  let+    l' = applyListOps op ops l+    l'' = converge ((==) `on` (^. listSelectedL)) listMoveDown l'+    len = length (l'' ^. listElementsL)+  in+    maybe (len == 0) (== len - 1) (l'' ^. listSelectedL)++-- move ops never change the list+prop_moveOpsNeverChangeList :: (Eq a) => [ListMoveOp a] -> List n a -> Bool+prop_moveOpsNeverChangeList ops l =+  let+    l' = applyListOps moveOp ops l+  in+    l' ^. listElementsL == l ^. listElementsL++-- If the list is empty, empty selection is used.+-- Otherwise, if the specified selected index is not in list bounds,+-- zero is used instead.+prop_replaceSetIndex+  :: (Eq a)+  => [ListOp a] -> List n a -> [a] -> Int -> Bool+prop_replaceSetIndex ops l xs i =+  let+    v = V.fromList xs+    l' = applyListOps op ops l+    l'' = listReplace v (Just i) l'+    i' = clamp 0 (length v - 1) i+    inBounds = i == i'+  in+    l'' ^. listSelectedL == case (null v, inBounds) of+      (True, _) -> Nothing+      (False, True) -> Just i+      (False, False) -> Just 0++-- Replacing with no index always clears the index+prop_replaceNoIndex :: (Eq a) => [ListOp a] -> List n a -> [a] -> Bool+prop_replaceNoIndex ops l xs =+  let+    v = V.fromList xs+    l' = applyListOps op ops l+  in+    isNothing (listReplace v Nothing l' ^. listSelectedL)++-- | Move the list selected index. If the index is `Just x`, adjust by the+-- specified amount; if it 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). Subject to validation.+prop_moveByWhenNoSelection :: List n a -> Int -> Property+prop_moveByWhenNoSelection l amt =+  let+    l' = l & listSelectedL .~ Nothing+    len = length (l ^. listElementsL)+    expected = if amt > 0 then 0 else len - 1+  in+    len > 0 ==> listMoveBy amt l' ^. listSelectedL == Just expected+++splitAtLength :: (Foldable t, Splittable t) => t a -> Int -> Bool+splitAtLength l i =+  let+    len = length l+    (h, t) = splitAt i l+  in+    length h + length t == len+    && length h == clamp 0 len i++splitAtAppend+  :: (Splittable t, Semigroup (t a), Eq (t a))+  => t a -> Int -> Bool+splitAtAppend l i = uncurry (<>) (splitAt i l) == l++prop_splitAtLength_Vector :: [a] -> Int -> Bool+prop_splitAtLength_Vector = splitAtLength . V.fromList++prop_splitAtAppend_Vector :: (Eq a) => [a] -> Int -> Bool+prop_splitAtAppend_Vector = splitAtAppend . V.fromList++prop_splitAtLength_Seq :: [a] -> Int -> Bool+prop_splitAtLength_Seq = splitAtLength . Seq.fromList++prop_splitAtAppend_Seq :: (Eq a) => [a] -> Int -> Bool+prop_splitAtAppend_Seq = splitAtAppend . Seq.fromList+++reverseSingleton+  :: forall t a. (Reversible t, Applicative t, Eq (t a))+  => Proxy t -> a -> Bool+reverseSingleton _ a =+  let l = pure a :: t a+  in reverse l == l++reverseAppend+  :: (Reversible t, Semigroup (t a), Eq (t a))+  => t a -> t a -> Bool+reverseAppend l1 l2 =+  reverse (l1 <> l2) == reverse l2 <> reverse l1++prop_reverseSingleton_Vector :: (Eq a) => a -> Bool+prop_reverseSingleton_Vector = reverseSingleton (Proxy :: Proxy V.Vector)++prop_reverseAppend_Vector :: (Eq a) => [a] -> [a] -> Bool+prop_reverseAppend_Vector l1 l2 =+  reverseAppend (V.fromList l1) (V.fromList l2)++prop_reverseSingleton_Seq :: (Eq a) => a -> Bool+prop_reverseSingleton_Seq = reverseSingleton (Proxy :: Proxy Seq.Seq)++prop_reverseAppend_Seq :: (Eq a) => [a] -> [a] -> Bool+prop_reverseAppend_Seq l1 l2 =+  reverseAppend (Seq.fromList l1) (Seq.fromList l2)++++-- Laziness tests.  Here we create a custom container type+-- that we use to ensure certain operations do not cause the+-- whole container to be evaulated.+--+newtype L a = L [a]+  deriving (Functor, Foldable, Traversable)++instance Splittable L where+  splitAt i (L xs) = over both L (Data.List.splitAt i xs)++-- moveBy positive amount does not evaluate 'length'+prop_moveByPosLazy :: Bool+prop_moveByPosLazy =+  let+    v = L (1:2:3:4:undefined) :: L Int+    l = list () v 1+    l' = listMoveBy 1 l+  in+    l' ^. listSelectedL == Just 1+++return []++main :: IO Bool+main = $quickCheckAll

@@ -3,6 +3,7 @@  import Control.Applicative import Data.Bool (bool)+import Data.Traversable (sequenceA) import System.Exit (exitFailure, exitSuccess)  import Data.IMap (IMap, Run(Run))@@ -11,6 +12,8 @@ import qualified Data.IMap as IMap import qualified Data.IntMap as IntMap +import qualified List+ instance Arbitrary v => Arbitrary (Run v) where     arbitrary = liftA2 (\(Positive n) -> Run n) arbitrary arbitrary @@ -107,4 +110,6 @@ return []  main :: IO ()-main = $quickCheckAll >>= bool exitFailure exitSuccess+main =+  (all id <$> sequenceA [$quickCheckAll, List.main])+  >>= bool exitFailure exitSuccess