OutputContainer.hs

module UI.Widgets.OutputContainer where

import Control.Concurrent
import qualified Control.Concurrent.STM as STM
import qualified Data.List as DL
import qualified Data.Text as T
import qualified System.IO as SIO

import Common
import DiffRender.DiffRender
import UI.Widgets.Common

data OutputContainer = OutputContainer
  { ocwHandle       :: SIO.Handle
  , ocwDim          :: Dimensions
  , ocwPos          :: ScreenPos
  , ocwVisibility   :: Bool
  , ocwBufferRef    :: STM.TVar Text
  }

clearOutput :: WidgetC m => WRef OutputContainer -> m ()
clearOutput ref = do
  w <- readWRef ref
  liftIO $ STM.atomically $ STM.writeTVar (ocwBufferRef w) ""

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

instance Moveable OutputContainer where
  getPos ref = ocwPos <$> readWRef ref
  move ref pos =
    modifyWRef ref (\ocw -> ocw { ocwPos = pos })
  getDim ref = ocwDim <$> readWRef ref
  resize ref cb = do
    modifyWRef ref (\ocw -> ocw { ocwDim = cb $ ocwDim ocw })

dropExceptLast :: Int -> Text -> Text
dropExceptLast s l = T.drop (T.length l - s) l

dropExceptLastList :: Int -> [Text] -> [Text]
dropExceptLastList s l = DL.drop (DL.length l - s) l

instance Drawable OutputContainer where
  setVisibility ref v = modifyWRef ref (\b -> b { ocwVisibility = v })
  getVisibility ref = ocwVisibility <$> readWRef ref
  draw ref = do
    ocw <- readWRef ref
    let pos = ocwPos ocw

    stdOutChars <- liftIO (STM.readTVarIO (ocwBufferRef ocw))
    let stdOutLines = dropExceptLastList (diH $ ocwDim ocw) (T.split (== '\n') stdOutChars)
    forM_ (Prelude.zip [0..] stdOutLines) (\(idx, ln) -> do
      csSetCursorPosition (sX pos) (sY pos + idx)
      csPutText (Plain (T.take (diW $ ocwDim ocw) ln))
      )

outputContainer
  :: WidgetC m
  => SIO.Handle
  -> m (WRef OutputContainer)
outputContainer handle = do
  bufRef <- liftIO $ STM.newTVarIO ""
  void $ liftIO $ forkIO $ do
    forever $ do
      newChar <- liftIO $ SIO.hGetChar handle
      STM.atomically $ STM.modifyTVar bufRef (\ln -> T.snoc ln newChar)
  newWRef $ OutputContainer handle (Dimensions 0 0) (ScreenPos 0 0) True bufRef