LogWidget.hs

module UI.Widgets.LogWidget where

import Data.Text as T
import Data.Foldable
import qualified Data.Queue.Bounded as BQ
import Common
import System.Console.ANSI (Color(..))
import UI.Widgets.Common as C

import DiffRender.DiffRender

data LogEntry = LogEntry
  { leTimestamp :: Text
  , leLog :: Text
  }

data LogWidget = LogWidget
  { lwDim     :: Dimensions
  , lwContent :: BQ.BQueue LogEntry
  , lwPos     :: ScreenPos
  , lwVisible :: Bool
  }

emptyLog :: WidgetC m => WRef LogWidget -> m ()
emptyLog ref =
  modifyWRef ref (\lw -> lw { lwContent = BQ.empty (diH $ lwDim lw) })

insertLog :: WidgetC m => WRef LogWidget -> Text -> m ()
insertLog ref l = do
  timestr <- liftIO getLocalTimeString
  modifyWRef ref (\lw -> lw { lwContent = BQ.cons (LogEntry timestr l) (lwContent lw) })

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 -> let newDim = cb $ lwDim ww in  ww { lwDim = newDim, lwContent = resizeBq (diH newDim) (lwContent ww) })

resizeBq :: Int -> BQ.BQueue a -> BQ.BQueue a
resizeBq l q = BQ.fromList l $ toList $ q

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
    case lwVisible w of
      False -> pure ()
      True -> do
        forM_ (Prelude.zip [0 .. (diH (lwDim w) - 1)] (toList $ BQ.reverse $ lwContent w)) $ \(offset, li) -> do
          let startPos = (moveDown offset $ lwPos w)
          wSetCursor startPos
          csPutText $ StyledText (Fg Magenta) [Plain $ leTimestamp li, Plain ": "]
          let timeStampOffset = (T.length $ leTimestamp li) + 2
          wSetCursor (moveRight timeStampOffset startPos)
          let
            containableLength = diW (lwDim w) - timeStampOffset
            logContent = leLog li
            content = if T.length logContent > containableLength
              then T.take (containableLength - 2) logContent <> ".."
              else logContent
          csPutText $ StyledText (Fg Green) [Plain content]

logWidget
  :: forall m. WidgetC m => m (WRef LogWidget)
logWidget = do
  newWRef $
    LogWidget
    { lwDim = Dimensions 10 10
    , lwContent = BQ.empty 10
    , lwPos = ScreenPos 0 0
    , lwVisible = True
    }