WatchWidget.hs

module UI.Widgets.WatchWidget where

import Data.Proxy (Proxy)
import Data.Typeable (eqT, (:~:)(..))
import Data.Text as T

import Common
import UI.Widgets.Common as C

data WatchWidget = WatchWidget
  { wwDim     :: Dimensions
  , wwContent :: [(Text, Text)]
  , wwPos     :: ScreenPos
  , wwVisible :: Bool
  }

instance Container WatchWidget [(Text, Text)] where
  setContent ref c =
    modifyWRef ref (\ww -> ww { wwContent = c })
  getContent ref = wwContent <$> readWRef ref

instance Moveable WatchWidget where
  getPos ref = wwPos <$> readWRef ref
  move ref sp =
    modifyWRef ref (\ww -> ww { wwPos = sp })
  getDim ref =
    wwDim <$> readWRef ref
  resize ref cb =
    modifyWRef ref (\ww -> ww { wwDim = cb $ wwDim ww })

instance Widget WatchWidget where
  hasCapability (MoveableCap _)  = Just Dict
  hasCapability (DrawableCap _)  = Just Dict
  hasCapability (ContainerCap _ (_ :: Proxy cnt)) = case eqT @cnt @([(Text, Text)]) of
    Just Refl -> Just Dict
    Nothing   -> Nothing
  hasCapability _            = Nothing

instance Drawable WatchWidget where
  setVisibility ref v = modifyWRef ref (\b -> b { wwVisible = v })
  getVisibility ref = wwVisible <$> readWRef ref
  draw ref = do
    w <- readWRef ref
    drawBorderBox (wwPos w) (wwDim w)
    wSetCursor $ moveDown 1 $ moveRight 1 (wwPos w)
    flip mapM_ (Prelude.zip [1..] (wwContent w)) $ \(i, (k, v)) -> do
      wSetCursor $ moveDown i $ moveRight 1 (wwPos w)
      csPutText $ Plain $ T.take ((diW $ wwDim w) - 2) $ T.intercalate "|" [k, v]

watchWidget
  :: forall m. WidgetM m (WRef WatchWidget)
watchWidget = do
  newWRef $
    WatchWidget
    { wwDim = Dimensions 10 10
    , wwContent = []
    , wwPos = ScreenPos 0 0
    , wwVisible = False
    }