packages feed

spade-0.1.0.3: src/UI/Widgets/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
import UI.Widgets.Editor

data WatchWidget = WatchWidget
  { wwDim     :: Dimensions
  , wwContent :: [(Text, Text)]
  , wwContentWidget :: WRef EditorWidget
  , 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
    case wwVisible w of
      False -> pure ()
      True -> do
        move (wwContentWidget w) (wwPos w)
        resize (wwContentWidget w) (\_ -> wwDim w)
        setContent (wwContentWidget w) (T.intercalate "\n" (joinItems <$> (wwContent w)))
        draw (wwContentWidget w)
    where
      joinItems :: (Text, Text) -> Text
      joinItems (k, v) = k <> " = " <> v

watchWidget
  :: forall m. WidgetM m (WRef WatchWidget)
watchWidget = do
  ew <- editor (\_ -> pure []) Nothing
  modifyWRef ew (\ew' -> ew' { ewParams = (ewParams ew') { epBorder = False, epGutterSize = 0, epLinenumberRightPad = 0, epLineNos = False }})
  newWRef $
    WatchWidget
    { wwDim = Dimensions 10 10
    , wwContent = []
    , wwContentWidget = ew
    , wwPos = ScreenPos 0 0
    , wwVisible = False
    }