List.hs

{-# LANGUAGE ExistentialQuantification #-}
-- |This module provides a 'List' widget for rendering a list of
-- arbitrary widgets.  A 'List' has the following features:
--
-- * A style for the list elements
--
-- * A styled cursor indicating which element is selected
--
-- * A /window size/ indicating how many elements should be visible to
--   the user
--
-- * An internal pointer to the start of the visible window, which
--   automatically shifts as the list is scrolled
module Graphics.Vty.Widgets.List
    ( List
    , SimpleList
    , ListItem
    -- ** List creation
    , mkList
    , mkSimpleList
    -- ** List manipulation
    , scrollBy
    , scrollUp
    , scrollDown
    , pageUp
    , pageDown
    , resize
    -- ** List inspection
    , listItems
    , getSelected
    , selectedIndex
    , scrollTopIndex
    , scrollWindowSize
    , getVisibleItems
    )
where

import Graphics.Vty ( Attr, vert_cat )
import Graphics.Vty.Widgets.Base
    ( Widget(..)
    , Text
    , text
    , anyWidget
    , hFill
    )

-- |A list item. Each item contains an arbitrary internal identifier
-- @a@ and a widget @b@ representing it.
type ListItem a b = (a, b)

-- |The list widget type.  Lists are parameterized over the /internal/
-- /identifier type/ @a@, the type of internal identifiers used to
-- refer to the visible representations of the list contents, and the
-- /widget type/ @b@, the type of widgets used to represent the list
-- visually.
data List a b = List { normalAttr :: Attr
                     , selectedAttr :: Attr
                     , selectedIndex :: Int
                     -- ^The currently selected list index.
                     , scrollTopIndex :: Int
                     -- ^The start index of the window of visible list
                     -- items.
                     , scrollWindowSize :: Int
                     -- ^The size of the window of visible list items.
                     , listItems :: [ListItem a b]
                     -- ^The items in the list.
                     }

type SimpleList = List String Text

-- |Create a new list.  Emtpy lists and empty scrolling windows are
-- not allowed.
mkList :: (Widget b) =>
          Attr -- ^The attribute of normal, non-selected items
       -> Attr -- ^The attribute of the selected item
       -> Int -- ^The scrolling window size, i.e., the number of items
              -- which should be visible to the user at any given time
       -> [ListItem a b] -- ^The list items
       -> List a b
mkList _ _ _ [] = error "Lists cannot be empty"
mkList normAttr selAttr swSize contents
    | swSize <= 0 = error "Scrolling window size must be > 0"
    | otherwise = List normAttr selAttr 0 0 swSize contents

-- |A convenience function to create a new list using 'String's as the
-- internal identifiers and 'Text' widgets to represent those strings.
mkSimpleList :: Attr -- ^The attribute of normal, non-selected items
             -> Attr -- ^The attribute of the selected item
             -> Int -- ^The scrolling window size, i.e., the number of
                    -- items which should be visible to the user at
                    -- any given time
             -> [String] -- ^The list items
             -> SimpleList
mkSimpleList normAttr selAttr swSize labels =
    mkList normAttr selAttr swSize widgets
    where
      widgets = map (\l -> (l, text normAttr l)) labels

-- note that !! here will always succeed because selectedIndex will
-- never be out of bounds and the list will always be non-empty.
-- |Get the currently selected list item.
getSelected :: List a b -> ListItem a b
getSelected list = (listItems list) !! (selectedIndex list)

-- |Set the window size of the list.  This automatically adjusts the
-- window position to keep the selected item visible.
resize :: Int -> List a b -> List a b
resize newSize list
    | newSize == 0 = error "Cannot resize list window to zero"
    -- Do nothing if the window size isn't changing.
    | newSize == scrollWindowSize list = list
    -- If the new window size is larger, just set it.
    | newSize > scrollWindowSize list = list { scrollWindowSize = newSize }
    -- Otherwise it's smaller, so we need to look at which item is
    -- selected and decide whether to change the scrollTopIndex.
    | otherwise = list { scrollWindowSize = newSize
                       , selectedIndex = newSelected
                       }
    where
      newBottomPosition = scrollTopIndex list + newSize - 1
      current = selectedIndex list
      newSelected = if current > newBottomPosition
                    then newBottomPosition
                    else current

-- |Scroll a list up or down by the specified number of positions and
-- return the new scrolled list.  Scrolling by a positive amount
-- scrolls downward and scrolling by a negative amount scrolls upward.
-- This automatically takes care of managing internal list state:
--
-- * Moves the cursor by the specified amount and clamps the cursor
--   position to the beginning or the end of the list where
--   appropriate
--
-- * Moves the scrolling window position if necessary (i.e., if the
--   cursor moves to an item not currently in view)
scrollBy :: Int -> List a b -> List a b
scrollBy amount list =
    list { scrollTopIndex = adjustedTop
         , selectedIndex = newSelected }
        where
          sel = selectedIndex list
          lastPos = (length $ listItems list) - 1
          validPositions = [0..lastPos]
          newPosition = sel + amount

          newSelected = if newPosition `elem` validPositions
                        then newPosition
                        else if newPosition > lastPos
                             then lastPos
                             else 0

          bottomPosition = scrollTopIndex list + scrollWindowSize list - 1
          topPosition = scrollTopIndex list
          windowPositions = [topPosition..bottomPosition]

          adjustedTop = if newPosition `elem` windowPositions
                        then topPosition
                        else if newSelected >= bottomPosition
                             then newSelected - scrollWindowSize list + 1
                             else newSelected

-- |Scroll a list down by one position.
scrollDown :: List a b -> List a b
scrollDown = scrollBy 1

-- |Scroll a list up by one position.
scrollUp :: List a b -> List a b
scrollUp = scrollBy (-1)

-- |Scroll a list down by one page from the current cursor position.
pageDown :: List a b -> List a b
pageDown list = scrollBy (scrollWindowSize list) list

-- |Scroll a list up by one page from the current cursor position.
pageUp :: List a b -> List a b
pageUp list = scrollBy (-1 * scrollWindowSize list) list

-- |Given a 'List', return the items that are currently visible
-- according to the state of the list.  Returns the visible items and
-- flags indicating whether each is selected.
getVisibleItems :: List a b -> [(ListItem a b, Bool)]
getVisibleItems list =
    let start = scrollTopIndex list
        stop = scrollTopIndex list + scrollWindowSize list
        adjustedStop = (min stop $ length $ listItems list) - 1
    in [ (listItems list !! i, i == selectedIndex list)
             | i <- [start..adjustedStop] ]

instance (Widget b) => Widget (List a b) where
    growHorizontal _ = False
    growVertical _ = False

    withAttribute w att = w { normalAttr = att }

    primaryAttribute = normalAttr

    render s list =
        vert_cat images
            where
              images = map (render s) (visible ++ filler)
              visible = map highlight items
              items = map (\((_, w), sel) -> (w, sel)) $ getVisibleItems list
              filler = replicate (scrollWindowSize list - length visible)
                       (anyWidget $ hFill (normalAttr list) ' ' 1)
              highlight (w, selected) = let att = if selected
                                                  then selectedAttr
                                                  else normalAttr
                                        in anyWidget $ withAttribute w (att list)