{-# LANGUAGE OverloadedStrings #-}
module System.Taffybar.Widget.Decorators where

import           Control.Monad.IO.Class
import qualified GI.Gtk as Gtk
import           System.Taffybar.Widget.Util

-- | Wrap a widget with two container boxes. The inner box will have the class
-- "InnerPad", and the outer box will have the class "OuterPad". These boxes can
-- be used to add padding between the outline of the widget and its contents, or
-- for the purpose of displaying a different background behind the widget.
buildPadBox :: MonadIO m => Gtk.Widget -> m Gtk.Widget
buildPadBox :: Widget -> m Widget
buildPadBox Widget
contents = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
  Box
innerBox <- Orientation -> Int32 -> IO Box
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Orientation -> Int32 -> m Box
Gtk.boxNew Orientation
Gtk.OrientationHorizontal Int32
0
  EventBox
outerBox <- IO EventBox
forall (m :: * -> *). (HasCallStack, MonadIO m) => m EventBox
Gtk.eventBoxNew
  Box -> Widget -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
Gtk.containerAdd Box
innerBox Widget
contents
  EventBox -> Box -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
Gtk.containerAdd EventBox
outerBox Box
innerBox
  Box
_ <- Box -> Text -> IO Box
forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
widgetSetClassGI Box
innerBox Text
"inner-pad"
  EventBox
_ <- EventBox -> Text -> IO EventBox
forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
widgetSetClassGI EventBox
outerBox Text
"outer-pad"
  EventBox -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShow EventBox
outerBox
  Box -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShow Box
innerBox
  EventBox -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget EventBox
outerBox

buildContentsBox :: MonadIO m => Gtk.Widget -> m Gtk.Widget
buildContentsBox :: Widget -> m Widget
buildContentsBox Widget
widget = IO Widget -> m Widget
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Widget -> m Widget) -> IO Widget -> m Widget
forall a b. (a -> b) -> a -> b
$ do
  Box
contents <- Orientation -> Int32 -> IO Box
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Orientation -> Int32 -> m Box
Gtk.boxNew Orientation
Gtk.OrientationHorizontal Int32
0
  Box -> Widget -> IO ()
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsContainer a, IsWidget b) =>
a -> b -> m ()
Gtk.containerAdd Box
contents Widget
widget
  Box
_ <- Box -> Text -> IO Box
forall b (m :: * -> *). (IsWidget b, MonadIO m) => b -> Text -> m b
widgetSetClassGI Box
contents Text
"contents"
  Box -> IO ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsWidget a) =>
a -> m ()
Gtk.widgetShowAll Box
contents
  Box -> IO Widget
forall (m :: * -> *) o. (MonadIO m, IsWidget o) => o -> m Widget
Gtk.toWidget Box
contents IO Widget -> (Widget -> IO Widget) -> IO Widget
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Widget -> IO Widget
forall (m :: * -> *). MonadIO m => Widget -> m Widget
buildPadBox