content: {-# language
      TemplateHaskell
    , ExistentialQuantification
    , RankNTypes
    , OverloadedStrings
  #-}
  module Rasa.Ext.Views.Internal.Widgets
    ( Widgets
    , HasWidgets(..)
    , addTopBar
    , addBottomBar
    , addLeftBar
    , addRightBar
    , topBar
    , bottomBar
    , leftBar
    , rightBar
    ) where
  
  import Rasa.Ext
  import Rasa.Ext.Views.Internal.Views
  import Rasa.Ext.Views.Internal.AnyRenderable
  import Rasa.Ext.Views.Internal.ActiveBar
  import Rasa.Ext.Views.Internal.StatusBar
  
  import Control.Lens
  import Data.Maybe
  import Data.Monoid
  
  
  -- | Represents all widgets for a given view. Can be added onto using the Monoid instance.
  data Widgets = Widgets
    { _topBar :: [AnyRenderable]
    , _bottomBar :: [AnyRenderable]
    , _leftBar :: [AnyRenderable]
    , _rightBar :: [AnyRenderable]
    }
  
  makeLenses ''Widgets
  
  instance Semigroup Widgets where
    (Widgets a b c d) <> (Widgets a' b' c' d') =
      Widgets (a<>a') (b<>b') (c<>c') (d<>d')
    
  instance Monoid Widgets where
    mempty = Widgets mempty mempty mempty mempty
  
  class HasWidgets r where
    computeWidgets :: r -> App Widgets
  
  -- | This represents types which can provide a set of widgets
  instance HasWidgets View where
    computeWidgets vw = do
      rest <- case vw^.viewable of
                EmptyView -> return mempty
                (BufView br) -> getBufWidgets br
      return $ activeBar `mappend` rest
      where
        activeBar =
          if vw^.active
            then mempty & bottomBar .~ [AnyRenderable ActiveBar]
            else mempty
  
        getBufWidgets br = fmap (fromMaybe mempty) . bufDo br $ do
          mainWidgets <- getWidgets
          topStatusBar <- getTopStatusBar
          bottomStatusBar <- getBottomStatusBar
          return $ mainWidgets <> widgetOf bottomBar bottomStatusBar <> widgetOf topBar topStatusBar
  
  data GetWidgets = GetWidgets
  
  widgetOf :: Renderable r => Lens' Widgets [AnyRenderable] -> r -> Widgets
  widgetOf l r = mempty & l .~ [AnyRenderable r]
  
  mkListenerFor :: Renderable r => Lens' Widgets [AnyRenderable] -> BufAction r -> BufAction ListenerId
  mkListenerFor l bufAction = addBufListener (const (widgetOf l <$> bufAction) :: GetWidgets -> BufAction Widgets)
  
  -- | Use the computed renderer as a left-bar widget
  addLeftBar :: Renderable r => BufAction r -> BufAction ListenerId
  addLeftBar = mkListenerFor leftBar
  
  -- | Use the computed renderer as a right-bar widget
  addRightBar :: Renderable r => BufAction r -> BufAction ListenerId
  addRightBar = mkListenerFor rightBar
  
  -- | Use the computed renderer as a top-bar widget
  addTopBar :: Renderable r => BufAction r -> BufAction ListenerId
  addTopBar = mkListenerFor topBar
  
  -- | Use the computed renderer as a bottom-bar widget
  addBottomBar :: Renderable r => BufAction r -> BufAction ListenerId
  addBottomBar = mkListenerFor bottomBar
  
  getWidgets :: BufAction Widgets
  getWidgets = dispatchBufEvent GetWidgets
  