{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2017 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns    #-}

module Simple.UI.Widgets.SimpleMenuBar (
    SimpleMenuBar,
    SimpleMenuBarClass,
    castToSimpleMenuBar,
    simpleMenuBarNew,
    menuBarItemAdd
) where

import           Control.Lens                          (makeLensesFor, (.=))
import           Control.Monad
import qualified Graphics.Vty                          as Vty

import           Simple.UI.Core.Attribute
import           Simple.UI.Core.ListenerList
import           Simple.UI.Core.UIApp
import           Simple.UI.Layouts.FillLayout
import           Simple.UI.Widgets.Container
import           Simple.UI.Widgets.Properties.Selected
import           Simple.UI.Widgets.SimpleMenuItem
import           Simple.UI.Widgets.Widget

data SimpleMenuBar = SimpleMenuBar
    { SimpleMenuBar -> Widget
_simpleMenuBarParent    :: Widget
    , SimpleMenuBar -> Container FillLayout
_simpleMenuBarContainer :: Container FillLayout
    , SimpleMenuBar -> AttributeList SimpleMenuItem
_simpleMenuBarItems     :: AttributeList SimpleMenuItem
    }

makeLensesFor [("_simpleMenuBarParent", "simpleMenuBarParent")] ''SimpleMenuBar

class WidgetClass w => SimpleMenuBarClass w where
    castToSimpleMenuBar :: w -> SimpleMenuBar

    menuBarItemAdd :: SimpleMenuItemClass item => w -> item -> UIApp u ()
    menuBarItemAdd (w -> SimpleMenuBar
forall w. SimpleMenuBarClass w => w -> SimpleMenuBar
castToSimpleMenuBar -> SimpleMenuBar
menuBar) (item -> SimpleMenuItem
forall w. SimpleMenuItemClass w => w -> SimpleMenuItem
castToSimpleMenuItem -> SimpleMenuItem
item) = do
        SimpleMenuBar
-> UIApp u (Color, Color, DrawStyle, Color, Color, DrawStyle)
forall w u.
WidgetClass w =>
w -> UIApp u (Color, Color, DrawStyle, Color, Color, DrawStyle)
getColors SimpleMenuBar
menuBar UIApp u (Color, Color, DrawStyle, Color, Color, DrawStyle)
-> ((Color, Color, DrawStyle, Color, Color, DrawStyle)
    -> UIApp u ())
-> UIApp u ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= SimpleMenuItem
-> (Color, Color, DrawStyle, Color, Color, DrawStyle) -> UIApp u ()
forall w u.
WidgetClass w =>
w
-> (Color, Color, DrawStyle, Color, Color, DrawStyle) -> UIApp u ()
setColors SimpleMenuItem
item
        SimpleMenuBar
menuBar SimpleMenuBar -> SimpleMenuItem -> UIApp u ()
forall w v u.
(WidgetClass w, WidgetClass v) =>
w -> v -> UIApp u ()
`connectColorsTo` SimpleMenuItem
item
        Container FillLayout
-> SimpleMenuItem -> LayoutData FillLayout -> UIApp u ()
forall (w :: * -> *) u (m :: * -> *) a.
(ContainerClass w, WidgetClass u, MonadIO m) =>
w a -> u -> LayoutData a -> m ()
addTo (SimpleMenuBar -> Container FillLayout
_simpleMenuBarContainer SimpleMenuBar
menuBar) SimpleMenuItem
item FillLayoutData
forall a. Default a => a
def { fillLayoutHExpand :: Bool
fillLayoutHExpand = Bool
False }

        SimpleMenuBar
-> (SimpleMenuBar -> AttributeList SimpleMenuItem)
-> SimpleMenuItem
-> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> AttributeList a) -> a -> m ()
add' SimpleMenuBar
menuBar SimpleMenuBar -> AttributeList SimpleMenuItem
_simpleMenuBarItems SimpleMenuItem
item
        SimpleMenuItem
-> (SimpleMenuItem -> ListenerList (UIApp' ()))
-> UIApp' ()
-> UIApp u ()
forall w a u. w -> (w -> ListenerList a) -> a -> UIApp u ()
on_ SimpleMenuItem
item SimpleMenuItem -> ListenerList (UIApp' ())
forall w. SimpleMenuItemClass w => w -> ListenerList (UIApp' ())
activated (UIApp' () -> UIApp u ()) -> UIApp' () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ do
            [SimpleMenuItem]
items <- SimpleMenuBar
-> (SimpleMenuBar -> AttributeList SimpleMenuItem)
-> ReaderT (AppConfig ()) (StateT AppState IO) [SimpleMenuItem]
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get SimpleMenuBar
menuBar SimpleMenuBar -> AttributeList SimpleMenuItem
_simpleMenuBarItems
            [SimpleMenuItem] -> (SimpleMenuItem -> UIApp' ()) -> UIApp' ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SimpleMenuItem]
items ((SimpleMenuItem -> UIApp' ()) -> UIApp' ())
-> (SimpleMenuItem -> UIApp' ()) -> UIApp' ()
forall a b. (a -> b) -> a -> b
$ \SimpleMenuItem
i ->
                SimpleMenuItem
-> (SimpleMenuItem -> Attribute Bool) -> Bool -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set SimpleMenuItem
i SimpleMenuItem -> Attribute Bool
forall w. HasSelected w => w -> Attribute Bool
selected Bool
False
            SimpleMenuItem
-> (SimpleMenuItem -> Attribute Bool) -> Bool -> UIApp' ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set SimpleMenuItem
item SimpleMenuItem -> Attribute Bool
forall w. HasSelected w => w -> Attribute Bool
selected Bool
True

instance WidgetClass SimpleMenuBar where
    castToWidget :: SimpleMenuBar -> Widget
castToWidget = SimpleMenuBar -> Widget
_simpleMenuBarParent

    overrideWidget :: SimpleMenuBar -> State VirtualWidget () -> SimpleMenuBar
overrideWidget = Lens' SimpleMenuBar Widget
-> SimpleMenuBar -> State VirtualWidget () -> SimpleMenuBar
forall p w.
WidgetClass p =>
Lens' w p -> w -> State VirtualWidget () -> w
overrideWidgetHelper Lens' SimpleMenuBar Widget
simpleMenuBarParent

instance SimpleMenuBarClass SimpleMenuBar where
    castToSimpleMenuBar :: SimpleMenuBar -> SimpleMenuBar
castToSimpleMenuBar = SimpleMenuBar -> SimpleMenuBar
forall a. a -> a
id

simpleMenuBarNew :: UIApp u SimpleMenuBar
simpleMenuBarNew :: UIApp u SimpleMenuBar
simpleMenuBarNew = do
    FillLayout
_layout <- UIApp u FillLayout
forall u. UIApp u FillLayout
fillLayoutHorizontalNew
    Container FillLayout
container <- FillLayout -> UIApp u (Container FillLayout)
forall a u. LayoutClass a => a -> UIApp u (Container a)
containerNew FillLayout
_layout

    AttributeList SimpleMenuItem
itemList <- [SimpleMenuItem]
-> ReaderT
     (AppConfig u) (StateT AppState IO) (AttributeList SimpleMenuItem)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew []

    let _simpleMenuBar :: SimpleMenuBar
_simpleMenuBar = SimpleMenuBar :: Widget
-> Container FillLayout
-> AttributeList SimpleMenuItem
-> SimpleMenuBar
SimpleMenuBar
            { _simpleMenuBarParent :: Widget
_simpleMenuBarParent = Container FillLayout -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget Container FillLayout
container
            , _simpleMenuBarContainer :: Container FillLayout
_simpleMenuBarContainer = Container FillLayout
container
            , _simpleMenuBarItems :: AttributeList SimpleMenuItem
_simpleMenuBarItems = AttributeList SimpleMenuItem
itemList
            }

    let simpleMenuBar :: SimpleMenuBar
simpleMenuBar = SimpleMenuBar -> State VirtualWidget () -> SimpleMenuBar
forall w. WidgetClass w => w -> State VirtualWidget () -> w
overrideWidget SimpleMenuBar
_simpleMenuBar (State VirtualWidget () -> SimpleMenuBar)
-> State VirtualWidget () -> SimpleMenuBar
forall a b. (a -> b) -> a -> b
$
            (String -> Identity String)
-> VirtualWidget -> Identity VirtualWidget
Lens' VirtualWidget String
virtualWidgetName ((String -> Identity String)
 -> VirtualWidget -> Identity VirtualWidget)
-> String -> State VirtualWidget ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= String
"simplemenuitem"

    SimpleMenuBar
-> (SimpleMenuBar -> Attribute Color)
-> Color
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set SimpleMenuBar
simpleMenuBar SimpleMenuBar -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorForeground Color
Vty.black
    SimpleMenuBar
-> (SimpleMenuBar -> Attribute Color)
-> Color
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set SimpleMenuBar
simpleMenuBar SimpleMenuBar -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorBackground Color
Vty.green
    SimpleMenuBar
-> (SimpleMenuBar -> Attribute Color)
-> Color
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set SimpleMenuBar
simpleMenuBar SimpleMenuBar -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorForegroundSelected Color
Vty.green
    SimpleMenuBar
-> (SimpleMenuBar -> Attribute Color)
-> Color
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set SimpleMenuBar
simpleMenuBar SimpleMenuBar -> Attribute Color
forall w. WidgetClass w => w -> Attribute Color
colorBackgroundSelected Color
Vty.brightBlack

    SimpleMenuBar -> UIApp u SimpleMenuBar
forall (m :: * -> *) a. Monad m => a -> m a
return SimpleMenuBar
simpleMenuBar