{-# LANGUAGE TypeOperators, Arrows, TypeFamilies, Rank2Types #-}
module JuicyBar.GTKDock
    (label, Text(..), Color(..), Click(..), Tooltip(..), run, UICircuit, fromCircuit)
where

import Data.Record as Record
import Data.Record.Optionality

import qualified Graphics.UI.Gtk as Gtk
import Graphics.UI.Gtk.Windows.Window (windowSetTypeHint,WindowTypeHint(..))
import Graphics.UI.Gtk.Gdk.EventM (eventButton, tryEvent, MouseButton(..))
import qualified Graphics.UI.Grapefruit.Circuit as UICircuit
import Graphics.UI.Grapefruit.Circuit hiding (run)
import Graphics.UI.Grapefruit.Item
import Graphics.UI.Grapefruit.GTK.Connector as GTKConnector
import Graphics.UI.Grapefruit.GTK
import Graphics.UI.Grapefruit.GTK.Item
import FRP.Grapefruit.Setup hiding (run)
import FRP.Grapefruit.Circuit
import FRP.Grapefruit.Signal
import FRP.Grapefruit.Signal.Discrete as DSignal 
import FRP.Grapefruit.Signal.Segmented as SSignal
import Control.Arrow
import Control.Monad.Trans (liftIO)

data Label = Label 
           { gtkLabel :: Gtk.Label
           , gtkEvBox :: Gtk.EventBox
           , gtkToolTip :: Gtk.Tooltips
           }

createLabel :: IO Label
createLabel = do
    l <- Gtk.labelNew Nothing
    e <- Gtk.eventBoxNew
    t <- Gtk.tooltipsNew
    e `Gtk.containerAdd` l
    Gtk.widgetModifyBg e Gtk.StateNormal (Gtk.Color 0 0 0)
    Gtk.widgetModifyFg l Gtk.StateNormal (Gtk.Color 65535 65535 65535)
    return Label { gtkLabel = l, gtkEvBox = e, gtkToolTip = t }

labelToWidget :: Label -> Gtk.Widget
labelToWidget l = Gtk.toWidget $ gtkEvBox l

data Text = Text
data Closure = Closure
data Click = Click
data Color = Color
data Tooltip = Tooltip

dockWindow :: Box UIItem Widget Window GTK X (X :& Closure ::: DSignal `Of` ())
dockWindow = windowBox createWindow 
                   Gtk.toWindow
                   Gtk.containerAdd
                   X
                   (X :& Closure := eventProducer Gtk.onDestroy)
    where createWindow = do
            window <- Gtk.windowNew
            Gtk.windowSetDefaultSize window 1280 (-1) -- XXX
            windowSetTypeHint window WindowTypeHintDock
            Gtk.widgetModifyBg window Gtk.StateNormal (Gtk.Color 0 0 0)
            return window

label :: Brick Widget GTK (X :& Req Text ::: SSignal `Of` String :& Opt Color ::: SSignal `Of` Gtk.Color :& Opt Tooltip ::: SSignal `Of` String)
                          (X :& Click ::: DSignal `Of` ())
label = widgetBrick createLabel
                    labelToWidget
                    (X :& Text    := (\l -> attrConsumer Gtk.labelLabel (gtkLabel l))
                       :& Color   := (\l -> SSignal.consumer (Gtk.widgetModifyFg (gtkLabel l) Gtk.StateNormal))
                       :& Tooltip := (\l -> SSignal.consumer (\text -> Gtk.tooltipsSetTip (gtkToolTip l) (gtkEvBox l) text ""))
                    )
                    (X :& Click  := (\l -> eventProducer onClicked (gtkEvBox l)))

onClicked :: (Gtk.WidgetClass b) => b -> IO () -> IO (Gtk.ConnectId b)
onClicked widget handler = Gtk.on widget Gtk.buttonPressEvent callback
    where
    callback = tryEvent $ do
        LeftButton <- eventButton
        liftIO handler

-- TODO: make spacing dependent on font size
hbox :: Box UICircuit Widget Widget GTK X X
hbox = widgetBox (fmap Gtk.toBox (Gtk.hBoxNew False 10))
                            Gtk.toWidget
                            (\box widg -> Gtk.boxPackStart box widg Gtk.PackNatural 0)
                            X
                            X

mainCircuit :: UICircuit Widget GTK era () () -> UICircuit Window GTK era () (DSignal era ())
mainCircuit content = proc _ -> do
    X :& Closure := closure `With` X `With` _  <- mainWindow -< X `With` X `With` ()
    returnA -< closure
    where
    mainWindow      = dockWindow `with` hbox `with` content

run :: (forall era . UICircuit Widget GTK era () ()) -> IO ()
run content = UICircuit.run GTK (mainCircuit content) ()