{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE CPP #-}

{-|
Module      : ItemField
Description : Selectable field of items and their current state
Copyright   : (c) Kevin Quick, 2016
License     : BSD-3
Maintainer  : quick@sparq.org
Stability   : stable
Portability : POSIX

The ItemField is used to keep track of the current status of a
potentially large number of items and visually indicate that status.
Further, it provides the ability to move the cursor around in the
field of items to "select" a particular item, as well as marking one
or more items for performing an operation on.

This widget is useful for handling data sets that are too large to
readily display with a List widget or similar functionality.  Each
item is represented by a single character on the screen, and these
characters are displayed in the specified groups.  Each item can have
an associated state, which is reflected in both the character used for
that item and the associated attributes:

@
    State           Character    Attribute
    Free (unmarked)    .         itemFreeAttr
    Marked             *         itemMarkedAttr
    Good               +         itemGoodAttr
    Bad                !         itemBadAttr
    Pending            ~         itemCaVaAttr
@

See below for the definitions of these and other attributes that can
be controlled by the user.

The widget provides a default event handler that handles the following:

- Arrow keys: move in the specified direction
- Mouse-click: move cursor to clicked item
- Space: select/deselect the item under the cursor (state->Marked or Free)
- Shift-RightArrow or Shift-LeftArrow: extend selection
- < or >: move 15 items backward or forward
- L: toggle Marked/Free for the current line
- G: toggle Marked/Free for the current group
- Mouse-click on a group: toggle Marked/Free for the current group
- A: toggle Marked/Free for all items
- +: change all Good items to Marked
- !: change all Bad items to Marked
- ~: change all Pending items to Marked
- s: change all Good items to Marked, everything else to Free
- f: change all Bad items to Marked, everything else to Free

Use @cabal configure -fexamples@ to build a couple of example programs
that use the ItemField and demonstrate its capabilities.

This module provides the top-level imports and the interaction with
the brick UI framework.

-}

module TextUI.ItemField
    ( module TextUI.ItemField.Types
      -- * Types
    , ItemFieldWidget(..)
    -- * Rendering
    , itemFieldWidget
#ifdef TEST
    , itemFieldRender -- export for testing only
#endif
    -- * Event handling
    , handleItemFieldEvent
    , withItemFieldWidth
    -- * Current item retrieval and manipulation
    , setItemState
    , getSelectedItem
    -- * Retrieving and updating marked items
    , getMarkedItems
    , setMarkedItemsState
    , module TextUI.ItemField.Attrs
    )
where

      -- KWQ: user provides marks?  that would imply state as well?  no for simplicity
      -- KWQ:  finish top level documentation.  Then ItemField is in good position refactoring lens, and then publishing.



import           Brick.AttrMap
import           Brick.Main (lookupViewport)
import           Brick.Types
import           Brick.Widgets.Core
import           Data.List
import           Data.Maybe (fromMaybe)
import qualified Data.Text as T
import           Graphics.Vty
import           Lens.Micro ((^.), _1)
import           TextUI.ItemField.Attrs
import           TextUI.ItemField.BrickHelper (getEventWidgetLocation)
import           TextUI.ItemField.Layout
import           TextUI.ItemField.Operations
import           TextUI.ItemField.Types


-- | This is the main widget for managing an ItemFieldWidget in a brick UI.
data ItemFieldWidget n =
    ItemFieldWidget { itemFieldName :: n
                    , itemField :: ItemField
                    }

instance Show (ItemFieldWidget n) where
    show = show . itemField

instance Named (ItemFieldWidget n) n where
    getName = itemFieldName


-- | This is the primary drawing description for the ItemField.  This
-- draws the widget in a viewport with the same name as the widget,
-- using the Fixed horizontal and vertical growth policies.
itemFieldWidget :: (Show n, Ord n) => ItemFieldWidget n -> Widget n
itemFieldWidget field =
    -- n.b. Use "Vertical" and not "Both" and accept "invisible" items if output screen is too narrow.  This is better than enabling horizontal scrolling, at which point the group names are never scrolled back into view.  could change this by making each group/line scrollable independently...
    let i = reportExtent (getName field) $
            viewport (getName field) Vertical $
            Widget Fixed Fixed $ fieldImageW field  -- KWQ: cached?
        s = Widget Fixed Fixed . summaryW field
    in case elemIdent $ itemField field of
         Nothing -> i
         Just sf -> i <=> s sf

fieldImageW :: ItemFieldWidget n -> RenderM n (Result n)
fieldImageW field =
    do ctx <- getContext
       let width = ctx^.availWidthL
           height = ctx^.availHeightL
           attrmap = ctx^.ctxAttrMapL
           (rdata, newImage) = itemFieldRender field attrmap width height
           cursor = CursorLocation cursorloc (Just $ getName field)
           cursorloc = itemFieldGetPos rdata field
       return $ Result newImage [cursor] [VR cursorloc (1,1)] []  -- KWQ: VR is internal.. can update with recent brick changes??

summaryW :: ItemFieldWidget n -> (Int -> ItemState -> T.Text)
         -> RenderM n (Result n)
summaryW field fn =
    do let s' = itemField field
           cs = curSel s'
           cs8 = itemst8 s' !! cs
       render $ identSel cs cs8 fn

itemFieldRender :: ItemFieldWidget n -> AttrMap -> Int -> Int
                -> (RenderData, Graphics.Vty.Image)
itemFieldRender field attrs width height =
    let s' = itemField field
        rdata = computeLinePosRanges width s'
        ls = redrawSt8Lines height (items s') (itemst8 s') rdata
        mkLineImg = horizCat . map mkColImg
        mkColImg (t,a) = string (attrMapLookup a attrs) $ T.unpack t
    in (rdata, vertCat $ map mkLineImg ls)

identSel :: Int -> ItemState -> (Int -> ItemState -> T.Text) -> Widget n
identSel cs cs8 sf =
    let msg = "#" ++ show cs ++ "  " ++ T.unpack (sf cs cs8)
    in withDefAttr itemSelectedDetailsAttr $ str msg

itemFieldGetPos :: RenderData -> ItemFieldWidget n -> Location
itemFieldGetPos rdata field =
    let mbl = pos_coordinates (itemField field) rdata
    in Location $ fromMaybe (5,0) mbl


-- | This is a handler that can be called from a higher level brick
-- Event handler to allow the item field to handle any keys or other
-- events that have not been handled by that higher level handler.  This handler provides handling for:
--
--   * movement via arrow keys and the '<' and '>' keys
--   * toggling marking items:
--            space = current item
--            L = current line
--            G = current group
--            A = all items
--   * extending marking by holding shift while using left or right arrow keys
--   * marking all items with a particular status by using the corrsponding key: +, !, or ~
--
handleItemFieldEvent :: (Ord n) =>
                        Event -> ItemFieldWidget n -> EventM n (ItemFieldWidget n)
handleItemFieldEvent event fieldw =
    let marking mods = MShift `elem` mods
        allWithState s = elemIndices s $ itemst8 $ itemField fieldw
        oldItm = itemField fieldw
        clrItm = setAllFree oldItm
        onFldWidget fld fun itmLst = let newItm = foldl fun fld itmLst
                                     in fieldw { itemField = newItm }
        markItem = changeItemState Marked
        handleKey key mods = case key of
          KRight -> selectNextItem (marking mods) fieldw
          KLeft -> selectPrevItem (marking mods) fieldw
          KChar '>' -> selectForwardBy 15 False fieldw
          KChar '<' -> selectBackwardBy 15 False fieldw
          -- -- shift + KUp or KDown is not supported, so just do regular movement
          KDown  -> withItemFieldWidth fieldw $ \w -> selectNextLineItem w False fieldw
          KUp  -> withItemFieldWidth fieldw $ \w -> selectPrevLineItem w False fieldw
          -- marked item toggling: space = single item, L = line, G = current group, A = all items
          KChar ' ' -> toggleMark fieldw [curSel $ itemField fieldw]
          KChar 'L'  -> toggleLineMarks fieldw
          KChar 'G' -> toggleGroupMarks fieldw
          KChar 'A' -> toggleAllMarks fieldw
          -- set marks based on existing state
          KChar '+' -> setMark Marked fieldw $ allWithState Good
          KChar '!' -> setMark Marked fieldw $ allWithState Bad
          KChar '~' -> setMark Marked fieldw $ allWithState CaVa
          KChar 's' -> return $ onFldWidget clrItm markItem $ allWithState Good
          KChar 'f' -> return $ onFldWidget clrItm markItem $ allWithState Bad
          _ -> return fieldw
    in case event of
         EvKey key mods -> handleKey key mods
         EvMouseDown mcol mrow _button _mods ->
             do wcoords <- getEventWidgetLocation fieldw mcol mrow
                case wcoords of
                  Nothing -> return fieldw
                  Just l -> withItemFieldWidth fieldw $ \w ->
                             let rdata = computeLinePosRanges w $ itemField fieldw
                                 selly = coordinatesSel oldItm rdata $ loc l
                             in case selly of
                                  Nothing -> return fieldw
                                  Just (ItemLocNum n) -> selectItemNum n fieldw
                                  Just (ItemLocGroup n s) -> selectItemNum n fieldw >>= toggleNamedGroupMarks s
         -- EvMouseUp col row button  -> error $ "MouseUp at " <> show col <> " / " <> show row <> " with " <> show button
         _ -> return fieldw


-- | Useful function for writing custom event handlers for the
-- ItemFieldWidget.  This wrapper can provide the width of the
-- rendered ItemFieldWidget to the custom event handler.
withItemFieldWidth :: Ord n
                      => ItemFieldWidget n
                   -> (Int -> EventM n (ItemFieldWidget n))
                   -> EventM n (ItemFieldWidget n)
withItemFieldWidth fieldw op =
    do v <- lookupViewport $ itemFieldName fieldw
       case v of
         Nothing -> return fieldw
         Just vp -> op $ vp^.vpSize._1


-- ----------------------------------------------------------------------
-- Movement Functions

type ItemFieldEventHandler n = ItemFieldWidget n -> EventM n (ItemFieldWidget n)

-- | Select specific item by Id
selectItemNum :: Int -> ItemFieldEventHandler n
selectItemNum n = selectUpdate (update_position $ const . const n) False

-- | Select the next or previous item in the item field, moving the
-- cursor accordingly.  The first argument should be true if the
-- state of the newly selected item should be the same as the state of
-- the current item.
selectNextItem, selectPrevItem :: Bool -> ItemFieldEventHandler n
selectNextItem = selectUpdate select_next
selectPrevItem = selectUpdate select_prev

-- | Move the selection forward or backward by the specified number of
-- items in the first argument.  Movement will be stopped at the first
-- or last item, so specifying a move beyond those boundaries is safe.
-- The second argument is a boolean that specifies the extension of
-- the current items state across the selection movement (similar to
-- the use of the boolean argument for the 'selectNextItem' and
-- 'selectPrevItem' functions).
selectForwardBy, selectBackwardBy :: Int -> Bool -> ItemFieldEventHandler n
selectForwardBy n = selectUpdate (select_forward_n n)
selectBackwardBy n = selectUpdate (select_backward_n n)

-- | Move the selection to the next line or previous line.  The first
-- argument specifies the rendering width of the region (viewport)
-- that contains the ItemFieldWidget, which allows it to compute the
-- line lengths to determine what the target item is for a forward or
-- backward line motion.  The boolean argument specifies whether the
-- intervening and target selection item's states are to be set to the
-- current item's state, just as with the 'selectForwardBy' and
-- 'selectBackwardBy' functions.
selectNextLineItem, selectPrevLineItem
    :: Int  -- ^ the rendering width of the region that contains the ItemFieldWidget
    -> Bool -- ^ should items between source and destination be set to the source's state?
    -> ItemFieldEventHandler n  -- ^ ItemFieldWidget to operate on and output EventM
selectNextLineItem width marking fieldw =
    let renderData = computeLinePosRanges width $ itemField fieldw
    in selectUpdate (select_next_line renderData) marking fieldw
selectPrevLineItem width marking fieldw =
    let renderData = computeLinePosRanges width $ itemField fieldw
    in selectUpdate (select_prev_line renderData) marking fieldw


selectUpdate :: FieldUpdateFunc -> Bool -> ItemFieldEventHandler n
selectUpdate updfun marking fld =
    let field = itemField fld
        (selrange, field') = updfun field
        firstMarked = head selrange `elem` getMarked field'
        markState = if firstMarked then Marked else Free
        field'' = if marking
                  then foldl (changeItemState markState) field' selrange
                  else field'
        fld' = fld { itemField = field'' }
    in return fld'


-- ----------------------------------------------------------------------
-- Marking Functions

toggleMark :: ItemFieldWidget n -> [Int] -> EventM n (ItemFieldWidget n)
toggleMark fieldw =
    let newSt8 = if selected `elem` marked then Free else Marked
        selected = curSel $ itemField fieldw
        marked = getMarked $ itemField fieldw
    in setMark newSt8 fieldw

setMark :: ItemState -> ItemFieldWidget n -> [Int] -> EventM n (ItemFieldWidget n)
setMark newSt8 fieldw = return . foldl (setItemState newSt8) fieldw

toggleAllMarks :: ItemFieldWidget n -> EventM n (ItemFieldWidget n)
toggleAllMarks fieldw = toggleMark fieldw allItems
    where allItems = [0 .. length (itemst8 $ itemField fieldw) - 1]

toggleGroupMarks :: ItemFieldWidget n -> EventM n (ItemFieldWidget n)
toggleGroupMarks fieldw = toggleMark fieldw groupItems
    where groupItems = [fst grng .. snd grng]
          grng = groupRange selected $ items $ itemField fieldw
          selected = curSel $ itemField fieldw

toggleNamedGroupMarks :: T.Text -> ItemFieldWidget n -> EventM n (ItemFieldWidget n)
toggleNamedGroupMarks grpspec fieldw = toggleMark fieldw groupItems
    where groupNames = T.splitOn (T.singleton '.') grpspec
          itms = items $ itemField fieldw
          itemStarts = snd $ mapAccumL (\a i -> let n = numItems i in (a+n, a)) 0 itms
          itemMatchSpans = map (matchGroupItem groupNames) itms
          groupRanges = map (\(s,m) -> if m == 0 then [] else [s .. s + m - 1]) $
                        zip itemStarts itemMatchSpans
          groupItems = concat groupRanges

          matchGroupItem :: [T.Text] -> Items -> Int
          matchGroupItem [] i = numItems i
          matchGroupItem (g:gs) (ItemGroup n i) = if n == g then matchGroupItem gs i else 0
          matchGroupItem _ _ = 0

toggleLineMarks :: Ord n => ItemFieldWidget n -> EventM n (ItemFieldWidget n)
toggleLineMarks fieldw =
    withItemFieldWidth fieldw $ \width ->
    let renderData = computeLinePosRanges width $ itemField fieldw
        lens = lineIndices $ renderedLines renderData
        lnum = fst $ curLine (itemField fieldw) renderData
        lrange = if lnum >= length lens
                 then error "handleItemFieldEvent index error"
                 else lens !! lnum
        Just lbeg = lineFirstIndex lrange
        Just lend = lineLastIndex lrange
    in if lrange == EmptyLine then return fieldw else toggleMark fieldw [lbeg .. lend]


-- ----------------------------------------------------------------------
-- Item retrieval and manipulation

-- | Returns the index of the currently selected item in the Widget's field
getSelectedItem :: ItemFieldWidget n -> Int
getSelectedItem = curSel . itemField


-- | Returns the list of the currently marked items in the Widget's field
getMarkedItems :: ItemFieldWidget n -> [Int]
getMarkedItems = getMarked . itemField


-- | Modifies the state of the specified item in the widget to the new value
setItemState :: ItemState -> ItemFieldWidget n -> Int -> ItemFieldWidget n
setItemState newState widget itemIdx =
    widget { itemField = changeItemState newState (itemField widget) itemIdx }


-- | Modifies the state of all currently marked items in the widget.
setMarkedItemsState :: ItemState -> ItemFieldWidget n -> ItemFieldWidget n
setMarkedItemsState newState widget =
    foldl (setItemState newState) widget $ getMarkedItems widget