LogWidget.hs

module UI.Widgets.LogWidget where

import Data.Text as T
import Text.Printf (printf)
import System.Console.ANSI (Color(..))
import Common
import Highlighter.Highlighter
import UI.Widgets.Common as C

data LogWidget = LogWidget
  { lwDim     :: Dimensions
  , lwContent :: [Text]
  , lwPos     :: ScreenPos
  , lwVisible :: Bool
  , lwScrollOffset :: Int
  }

insertLog :: WidgetC m => WRef LogWidget -> Text -> m ()
insertLog ref l = modifyWRef ref (\lw ->
  let
    h = diH $ lwDim lw
    ln = Prelude.length (lwContent lw)
    newContent = (lwContent lw) ++ [l]
  in if ln > h then lw { lwScrollOffset = 0, lwContent = Prelude.drop (ln - h) newContent } else lw { lwContent = newContent })

instance Moveable LogWidget where
  getPos ref = lwPos <$> readWRef ref
  move ref sp =
    modifyWRef ref (\ww -> ww { lwPos = sp })
  getDim ref =
    lwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\ww -> ww { lwDim = cb $ lwDim ww })

instance Widget LogWidget where
  hasCapability (MoveableCap _)  = Just Dict
  hasCapability (DrawableCap _)  = Just Dict
  hasCapability _            = Nothing

instance Drawable LogWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { lwVisible = v })
  getVisibility ref = lwVisible <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    let height = (diH $ lwDim w) - 3
    let width = (diW $ lwDim w) - 3
    let scrollOffset = lwScrollOffset w
    drawBorderBox (lwPos w) (lwDim w)
    wSetCursor $ moveDown 1 $ moveRight 1 (lwPos w)
    let fmt = "%-" <> (show (width + 1)) <> "s"
    csPutText $ colorText White Black (T.pack $ printf fmt (" Logs" :: Text))
    let lines' = Prelude.concat $ T.splitOn "\n" <$> lwContent w
    lst <- foldM (\offset line -> do
      let chunksize = (diW $ lwDim w) - 2
      let segments = T.chunksOf chunksize line
      foldM (\soffset chunk -> do
        when ((soffset > scrollOffset) && ((soffset - scrollOffset) <= height) ) $ do
          let cp = moveUp scrollOffset $ moveDown (soffset + 1)  $ moveRight 1 (lwPos w)
          wSetCursor cp
          csPutText $ Plain (T.replicate chunksize " ")
          wSetCursor cp
          csPutText $ Plain (T.strip chunk)
        pure (soffset + 1)
        ) offset segments
      ) 1 lines'
    let overflow = (((lst - 1) - scrollOffset) - height)
    when (overflow > 0) $ do
      modifyWRef ref (\a -> a { lwScrollOffset = lwScrollOffset a + overflow })
      draw ref

logWidget
  :: forall m. WidgetM m (WRef LogWidget)
logWidget = do
  newWRef $
    LogWidget
    { lwDim = Dimensions 10 10
    , lwContent = []
    , lwPos = ScreenPos 0 0
    , lwVisible = True
    , lwScrollOffset = 0
    }