List.hs

{-# LANGUAGE TupleSections #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}
-- | This module provides a scrollable list type and functions for
-- manipulating and rendering it.
module Brick.Widgets.List
  ( List(listElements, listSelected, listName, listElementDraw)

  -- * Consructing a list
  , list

  -- * Rendering a list
  , renderList

  -- * Lenses
  , listElementsL
  , listSelectedL
  , listNameL

  -- * Manipulating a list
  , listMoveBy
  , listMoveTo
  , listMoveUp
  , listMoveDown
  , listInsert
  , listRemove
  , listReplace
  , listSelectedElement

  -- * Attributes
  , listAttr
  , listSelectedAttr
  )
where

import Control.Applicative ((<$>))
import Control.Lens ((^.), (&), (.~))
import Data.Monoid ((<>))
import Data.Maybe (fromMaybe)
import qualified Data.Algorithm.Diff as D
import Graphics.Vty (Event(..), Key(..))

import Brick.Types
import Brick.Widgets.Core
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:
--
-- * Up/down arrow keys: move cursor of selected item
data List e =
    List { listElements :: ![e]
         , listElementDraw :: Bool -> e -> Widget
         , listSelected :: !(Maybe Int)
         , listName :: Name
         }

suffixLenses ''List

instance HandleEvent (List e) where
    handleEvent e theList = f theList
        where
            f = case e of
                  EvKey KUp [] -> listMoveUp
                  EvKey KDown [] -> listMoveDown
                  _ -> id

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

-- | The attribute used only for the currently-selected list item.
-- Extends 'listAttr'.
listSelectedAttr :: AttrName
listSelectedAttr = listAttr <> "selected"

-- | Construct a list in terms of an element type 'e'.
list :: Name
     -- ^ The list name (must be unique)
     -> (Bool -> e -> Widget)
     -- ^ The item rendering function (takes the item and whether it is
     -- currently selected)
     -> [e]
     -- ^ The initial list contents
     -> List e
list name draw es =
    let selIndex = if null es then Nothing else Just 0
    in List es draw selIndex name

-- | Turn a list state value into a widget.
renderList :: List e -> Widget
renderList l = withDefAttr listAttr $
               viewport (l^.listNameL) Vertical $
               vBox $
               drawListElements l

drawListElements :: List e -> [Widget]
drawListElements l = drawnElements
    where
        es = l^.listElementsL
        drawnElements = (flip map) (zip [0..] es) $ \(i, e) ->
            let isSelected = Just i == l^.listSelectedL
                elemWidget = (l^.listElementDrawL) isSelected e
                makeVisible = if isSelected
                              then (visible . withDefAttr listSelectedAttr)
                              else id
            in makeVisible elemWidget

-- | Insert an item into a list at the specified position.
listInsert :: Int
           -- ^ The position at which to insert (0 <= i <= size)
           -> e
           -- ^ The element to insert
           -> List e
           -> List e
listInsert pos e l =
    let safePos = clamp 0 (length es) pos
        es = l^.listElementsL
        newSel = case l^.listSelectedL of
          Nothing -> 0
          Just s -> if safePos < s
                    then s + 1
                    else s
        (front, back) = splitAt safePos es
    in l & listSelectedL .~ Just newSel
         & listElementsL .~ (front ++ (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 e
           -> List e
listRemove pos l | null (l^.listElementsL) = l
                 | pos /= clamp 0 (length (l^.listElementsL) - 1) pos = l
                 | otherwise =
    let newSel = case l^.listSelectedL of
          Nothing -> 0
          Just s  -> if pos == 0
                     then 0
                     else if pos == s
                          then pos - 1
                          else if pos < s
                               then s - 1
                               else s
        (front, back) = splitAt pos es
        es' = front ++ tail back
        es = l^.listElementsL
    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 but
-- preserve the currently selected index.
listReplace :: Eq e => [e] -> List e -> List e
listReplace es' l | es' == l^.listElementsL = l
                  | otherwise =
    let sel = fromMaybe 0 (l^.listSelectedL)
        getNewSel es = case (null es, null es') of
          (_, True)      -> Nothing
          (True, False)  -> Just 0
          (False, False) -> Just (maintainSel es es' sel)
        newSel = getNewSel (l^.listElementsL)

    in l & listSelectedL .~ newSel
         & listElementsL .~ es'

-- | Move the list selected index up by one. (Moves the cursor up,
-- subtracts one from the index.)
listMoveUp :: List e -> List e
listMoveUp = listMoveBy (-1)

-- | Move the list selected index down by one. (Moves the cursor down,
-- adds one to the index.)
listMoveDown :: List e -> List e
listMoveDown = listMoveBy 1

-- | Move the list selected index by the specified amount, subject to
-- validation.
listMoveBy :: Int -> List e -> List e
listMoveBy amt l =
    let newSel = clamp 0 (length (l^.listElementsL) - 1) <$> (amt +) <$> (l^.listSelectedL)
    in l & listSelectedL .~ newSel

-- | Set the selected index for a list to the specified index, subject
-- to validation.
listMoveTo :: Int -> List e -> List e
listMoveTo pos l =
    let len = length (l^.listElementsL)
        newSel = clamp 0 (len - 1) $ if pos < 0 then (len - pos) else pos
    in l & listSelectedL .~ if len > 0
                            then Just newSel
                            else Nothing

-- | Return a list's selected element, if any.
listSelectedElement :: List e -> Maybe (Int, e)
listSelectedElement l = do
  sel <- l^.listSelectedL
  return (sel, (l^.listElementsL) !! sel)

-- Assuming `xs` is an existing list that we want to update to match the
-- state of `ys`. Given a selected index in `xs`, the goal is to compute
-- the corresponding index in `ys`.
maintainSel :: (Eq e) => [e] -> [e] -> Int -> Int
maintainSel xs ys sel = let hunks = D.getDiff xs ys
                        in merge 0 sel hunks

merge :: (Eq e) => Int -> Int -> [D.Diff e] -> Int
merge _   sel []                 = sel
merge idx sel (h:hs) | idx > sel = sel
                     | otherwise = case h of
    D.Both _ _ -> merge sel (idx + 1) hs

    -- element removed in new list
    D.First _  -> let newSel = if idx < sel
                               then sel - 1
                               else sel
                  in merge newSel idx hs

    -- element added in new list
    D.Second _ -> let newSel = if idx <= sel
                               then sel + 1
                               else sel
                  in merge newSel (idx + 1) hs