module TextUI.ItemField.Layout where


import Prelude hiding (length)
import Compat
import Data.Monoid ( (<>) )
import Data.Either
import Data.Maybe
import Data.List (mapAccumL)
import qualified Data.Text as T
import Brick.AttrMap
import TextUI.ItemField.Types
import TextUI.ItemField.Attrs


-- | Pre-compute the rendering information such as the number of items
-- per line and their offset.  This information is computed once and
-- used for various calculations.  This could have been implemented as
-- a MonadReader context, but the uses are all internal and fairly
-- simple, so direct argument passing is used for now.
data RenderData = RenderData Int [LinePosRange]  -- ^ width and line positions
                deriving (Eq, Show)


renderedLines :: RenderData -> [LinePosRange]
renderedLines (RenderData _ l) = l

renderWidth :: RenderData -> Int
renderWidth (RenderData w _) = w


-- | LinePosRange is the layout range of the items plotted on a line,
-- indicating the start column and length for that line.
data LinePosRange = LinePosRange Int Int -- start, length
                    deriving (Show, Eq)

lineStart, lineWidth, lineEnd :: LinePosRange -> Int
lineStart (LinePosRange s _) = s
lineWidth (LinePosRange _ w) = w
lineEnd   (LinePosRange s w) = s + w


-- | LineIndexRange is the Item indices for each line.  This is
-- similar to the LinePosRange, except that the latter has character
-- positions on screen.
data LineIndexRange = LineIndexRange Int Int | EmptyLine deriving (Show, Eq)

lineFirstIndex, lineLastIndex :: LineIndexRange -> Maybe Int
lineFirstIndex (LineIndexRange f _) = Just f
lineFirstIndex EmptyLine = Nothing

lineLastIndex  (LineIndexRange _ l) = Just l
lineLastIndex EmptyLine = Nothing


lineIndices :: [LinePosRange] -> [LineIndexRange]
lineIndices =
    let cvtFun prevEnd (LinePosRange _ w) = (prevEnd + w, nlr prevEnd w)
        nlr p l = if l == 0
                  then EmptyLine
                  else LineIndexRange p $ p + max 0 (l - 1)
    in snd . mapAccumL cvtFun 0


ssRep :: ItemState -> (T.Text, Brick.AttrMap.AttrName)
ssRep Free    = (T.singleton '.', itemFreeAttr)
ssRep Marked  = (T.singleton '*', itemMarkedAttr)
ssRep Good    = (T.singleton '+', itemGoodAttr)
ssRep Bad     = (T.singleton '!', itemBadAttr)
ssRep Pending = (T.singleton '~', itemPendingAttr)

groupSepText :: T.Text
groupSepText = T.singleton ' '
groupSepImg :: (T.Text, AttrName)
groupSepImg = (groupSepText, itemBlankAttr)

aSpace :: (T.Text, AttrName)
aSpace = (T.singleton ' ', itemBlankAttr)

aSpaces :: Int -> (T.Text, AttrName)
aSpaces n = (T.replicate n (T.singleton ' '), itemBlankAttr)


-------------------------------------------------------------------------
-- Layout Computation and Drawing
-------------------------------------------------------------------------

-- | Given the current display width, computes the LinePosRange (x offset
-- and count) of each line that would be displayed.  The display of
-- items for each group will be wrapped such that it does not exceed
-- the display width; the exception is if the group text would exceed
-- the display width, in which case there is no wrapping for the
-- groups and horizontal scrolling is indicated and the render data
-- width will be reset to the maximum width of the longest rendered
-- line without wrapping.
computeLinePosRanges :: Int -> ItemField -> RenderData
computeLinePosRanges dispWidth field =
    case partitionEithers $ layout (items field) of
      ([], l) -> RenderData dispWidth $ concat l
      (reqWidths, _) -> if maximum reqWidths == dispWidth
                        then abort
                        else computeLinePosRanges (maximum reqWidths) field
    where layout = snd . mapAccumL lay 0
          lay ind (ItemGroup nm gs) =
              (ind, snd $ lay (ind + T.length nm + sepwidth) gs)
          -- next is case where retried, but Items 0 so plot, don't Left again
          lay ind (Items 0) | ind <= dispWidth =
                                (ind, Right [LinePosRange ind 0])
          lay ind (Items n) =
              let rwidth = dispWidth - ind
                  (a,b) = n `divMod` rwidth
                  rng = map (LinePosRange ind) $ replicate a rwidth <> endrng
                  endrng = [b | a == 0 || b > 0 ]
              in if ind >= dispWidth
                 then (ind, Left $ ind + n)
                 else (ind, Right rng)
          sepwidth = T.length groupSepText
          abort = error $ "line computation cycling with " <> show dispWidth


-- | This is the overall drawing routine.  It generates a number of
-- lines that include the individual item states (via the `plot`
-- function below), along with any general messages or placeholders.
redrawSt8Lines :: Int -> [Items] -> [ItemState] -> RenderData -> [PlotLine]
redrawSt8Lines nLines si ss rdata =
    let sl = plot si ss rdata
        nCols = renderWidth rdata
        moreMsg = T.pack $ take nCols "+++ more +++"
        noneMsg = T.pack $ take nCols "[None identified yet]"
        centerTextLn t a = let ls = (nCols - T.length t) `div` 2
                               rs = nCols - ls - T.length t
                           in [ aSpaces ls, (t, a), aSpaces rs]
        slPlusMore = take (nLines-1) sl <>
                     [centerTextLn moreMsg itemMoreMessageAttr]
    in if null si || cntItems si == 0
       then [centerTextLn noneMsg itemNoneMessageAttr]
       else if length sl <= nLines then sl else slPlusMore


type PlotLine = [(T.Text, Brick.AttrMap.AttrName)]


-- | This is the main internal drawing routine.  Given the RenderData
-- calculations, the array of items, and the matching array of current
-- item states, this generates a list of each plotline.
plot :: [Items] -> [ItemState] -> RenderData -> [PlotLine]
plot ss st8st8 rdata = concat $ snd $ mapAccumL plt (st8st8, renderedLines rdata) ss
    where plt (si,rl) (Items 0) = ((si, tail rl), [[]])
          plt (si,rl) (Items n) =
              let (xx,yy) = splitAt curw $ si <> repeat Free
                  rng = head rl
                  curw = lineWidth rng
                  thisl = map ssRep xx
                  pltAcc' = (yy, tail rl)
                  (pltAcc'', cons) = plt pltAcc' $ Items $ n - curw
              in if n <= curw
                 then (pltAcc', [thisl])
                 else (pltAcc'', thisl : cons)
          plt pltAcc (ItemGroup nm gs) =
              let (pltAcc', grpl) = plt pltAcc gs
                  title = [(nm, itemHeaderAttr), groupSepImg]
                  prefixes = title : repeat [aSpaces $ T.length nm + 1]
                  glines = zipWith (<>) prefixes grpl
              in (pltAcc', glines)


-------------------------------------------------------------------------
-- Information
-------------------------------------------------------------------------

-- | Given the ItemField state, return the rendered line number and
-- character offset for the current selected item.
curLine :: ItemField -> RenderData -> (Int, Int)
curLine st rdata =
    let cs = curSel st
        lens = renderedLines rdata
        findLC n _ [] = (n,0) -- startup condition, no items
        findLC n c (l:ls) = if c < l
                            then (n, c)
                            else findLC (n+1) (c-l) ls
    in findLC 0 cs $ map lineWidth lens

-- | Given coordinates, return an indication of which item(s) is
-- selected by those coordinates
coordinatesSel :: ItemField -> RenderData -> (Int, Int) -> Maybe ItemLocation
coordinatesSel field rdata (col,row) =
    let lens = renderedLines rdata
        indices = lineIndices lens
        li = indices !! row
        lr = lens !! row
        itm = (col - lineStart lr) + fromJust (lineFirstIndex li)
    in if row >= length lens
       then Nothing
       else case lineFirstIndex li of
              Nothing -> Nothing
              Just l -> if col >= lineEnd lr
                        then Nothing
                        else if col < lineStart lr
                             then coordinatesGroup field col l
                             else Just $ ItemLocNum itm

coordinatesGroup :: ItemField -> Int -> Int -> Maybe ItemLocation
coordinatesGroup field col atItemNum =
    let itms = items field
        walkToGroup _ [] = Nothing
        walkToGroup (curIdx,grps) (ItemGroup nm ii : is) =
            walkToGroup (curIdx, (T.length nm, nm) : grps) (ii : is)
        walkToGroup (curIdx,grps) (Items n : is)
          | curIdx + n - 1 < atItemNum = walkToGroup (curIdx + n, []) is
          | curIdx /= atItemNum = Nothing -- not at first line of group
          | otherwise =  unwind (0,[]) $ reverse grps
        unwind _ [] = Nothing
        unwind (al,ag) ((l,g):gs) =
            if col < al + l
            then Just $ ItemLocGroup atItemNum $ T.intercalate (T.singleton '.') $ reverse $ g : ag
            else unwind (al + l + 1, g : ag) gs
    in walkToGroup (0,[]) itms

data ItemLocation = ItemLocNum Int | ItemLocGroup Int T.Text deriving Show


-------------------------------------------------------------------------
-- Moving and selecting
-------------------------------------------------------------------------

pos_coordinates :: ItemField -> RenderData -> Maybe (Int, Int)
pos_coordinates field rdata =
    let (cl,cc) = curLine field rdata
        lens = renderedLines rdata
        lrange = lens !! cl
        curX = toEnum $ cc + lineStart lrange
        curY = toEnum cl
    in if cl >= length lens then Nothing else Just (curX, curY)


update_position :: ([ItemState] -> Int -> Int) -> ItemField -> ([Int], ItemField)
update_position update_func field =
    let oldsel = curSel field
        newsel = update_func (itemst8 field) oldsel
        newfield = field { curSel = newsel }
        sel_range = if oldsel < newsel
                    then [oldsel .. newsel]
                    else [newsel .. oldsel]
    in (sel_range, newfield)


bounded :: Ord b => (a -> b) -> b -> b -> a -> b
bounded f minV maxV = max minV . min maxV . f

boundedIdx :: Foldable t => (a -> Int) -> t c -> a -> Int
boundedIdx f l = bounded f 0 (length l - 1)


-- | The FieldUpdateFunc modifies the current selection in an
-- ItemField, returning the old selection, the new selection, the
-- range over which the selection changed, and the updated field.
type FieldUpdateFunc = ItemField -> ([Int], ItemField)

select_next, select_prev :: FieldUpdateFunc
select_next = update_position (boundedIdx succ)
select_prev = update_position $ boundedIdx pred

select_forward_n, select_backward_n :: Int -> FieldUpdateFunc
select_forward_n n = update_position $ boundedIdx (n +)
select_backward_n n = update_position $ boundedIdx (\x -> x - n)


select_next_line, select_prev_line :: RenderData -> FieldUpdateFunc
select_next_line rdata field =
    let lens = renderedLines rdata
        (cl, cc) = curLine field rdata
        cc' = if (cl + 1) < length lens
              then min cc $ nextLW (cl + 1) - 1
              else cc
        nextLW ln = if ln == length lens then 0
                    else let tlw = lineWidth (lens !! ln)
                         in if tlw > 0 then tlw
                            else nextLW $ ln + 1
        inc = cc' + (lineWidth (lens !! cl) - cc)
    in update_position (boundedIdx (inc +)) field


select_prev_line rdata field =
    let lens = renderedLines rdata
        (cl,cc) = curLine field rdata
        prevLW ln = if ln == 0 then 0
                    else let tlw = lineWidth $ lens !! ln
                         in if tlw > 0 then tlw
                            else prevLW $ ln - 1
        cc' = if cl > 0
              then prevLW (cl-1) - min cc (prevLW (cl-1) - 1)
              else 0
        dec = cc + cc'
    in update_position (boundedIdx (\n -> n - dec)) field