{-
 *  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 #-}

module Simple.UI.Widgets.StatusBar (
    StatusBar,
    castToStatusBar,
    statusBarNew,
    textLeft,
    textCenter,
    textRight
) where

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

import           Simple.UI.Core.Internal.UIApp

import           Simple.UI.Core.Attribute
import           Simple.UI.Layouts.FillLayout
import           Simple.UI.Widgets.Container
import           Simple.UI.Widgets.Label
import           Simple.UI.Widgets.Text
import           Simple.UI.Widgets.Widget

data StatusBar = StatusBar
    { StatusBar -> Widget
_statusBarParent     :: Widget
    , StatusBar -> Label
_statusBarTextLeft   :: Label
    , StatusBar -> Label
_statusBarTextCenter :: Label
    , StatusBar -> Label
_statusBarTextRight  :: Label
    }

makeLensesFor [("_statusBarParent", "statusBarParent")] ''StatusBar

class WidgetClass w => StatusBarClass w where
    castToStatusBar :: w -> StatusBar

    textLeft :: w -> Attribute (Maybe String)
    textLeft = Label -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text (Label -> Attribute (Maybe String))
-> (w -> Label) -> w -> Attribute (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBar -> Label
_statusBarTextLeft (StatusBar -> Label) -> (w -> StatusBar) -> w -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> StatusBar
forall w. StatusBarClass w => w -> StatusBar
castToStatusBar

    textCenter :: w -> Attribute (Maybe String)
    textCenter = Label -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text (Label -> Attribute (Maybe String))
-> (w -> Label) -> w -> Attribute (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBar -> Label
_statusBarTextCenter (StatusBar -> Label) -> (w -> StatusBar) -> w -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> StatusBar
forall w. StatusBarClass w => w -> StatusBar
castToStatusBar

    textRight :: w -> Attribute (Maybe String)
    textRight = Label -> Attribute (Maybe String)
forall w. TextClass w => w -> Attribute (Maybe String)
text (Label -> Attribute (Maybe String))
-> (w -> Label) -> w -> Attribute (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StatusBar -> Label
_statusBarTextRight (StatusBar -> Label) -> (w -> StatusBar) -> w -> Label
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w -> StatusBar
forall w. StatusBarClass w => w -> StatusBar
castToStatusBar

instance StatusBarClass StatusBar where
    castToStatusBar :: StatusBar -> StatusBar
castToStatusBar = StatusBar -> StatusBar
forall a. a -> a
id

instance WidgetClass StatusBar where
    castToWidget :: StatusBar -> Widget
castToWidget = StatusBar -> Widget
_statusBarParent

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

statusBarNew :: UIApp u StatusBar
statusBarNew :: UIApp u StatusBar
statusBarNew = do
    Label
left   <- Maybe String -> UIApp u Label
forall u. Maybe String -> UIApp u Label
labelNew Maybe String
forall a. Maybe a
Nothing
    Label
-> (Label -> Attribute TextAlign)
-> TextAlign
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Label
left Label -> Attribute TextAlign
forall w. TextClass w => w -> Attribute TextAlign
align TextAlign
TextAlignLeft
    Label
center <- Maybe String -> UIApp u Label
forall u. Maybe String -> UIApp u Label
labelNew Maybe String
forall a. Maybe a
Nothing
    Label
-> (Label -> Attribute TextAlign)
-> TextAlign
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Label
center Label -> Attribute TextAlign
forall w. TextClass w => w -> Attribute TextAlign
align TextAlign
TextAlignCenter
    Label
right  <- Maybe String -> UIApp u Label
forall u. Maybe String -> UIApp u Label
labelNew Maybe String
forall a. Maybe a
Nothing
    Label
-> (Label -> Attribute TextAlign)
-> TextAlign
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Label
right Label -> Attribute TextAlign
forall w. TextClass w => w -> Attribute TextAlign
align TextAlign
TextAlignRight

    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
    Container FillLayout
-> Label
-> LayoutData FillLayout
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (w :: * -> *) u (m :: * -> *) a.
(ContainerClass w, WidgetClass u, MonadIO m) =>
w a -> u -> LayoutData a -> m ()
addTo Container FillLayout
container Label
left LayoutData FillLayout
forall a. Default a => a
def
    Container FillLayout
-> Label
-> LayoutData FillLayout
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (w :: * -> *) u (m :: * -> *) a.
(ContainerClass w, WidgetClass u, MonadIO m) =>
w a -> u -> LayoutData a -> m ()
addTo Container FillLayout
container Label
center LayoutData FillLayout
forall a. Default a => a
def
    Container FillLayout
-> Label
-> LayoutData FillLayout
-> ReaderT (AppConfig u) (StateT AppState IO) ()
forall (w :: * -> *) u (m :: * -> *) a.
(ContainerClass w, WidgetClass u, MonadIO m) =>
w a -> u -> LayoutData a -> m ()
addTo Container FillLayout
container Label
right LayoutData FillLayout
forall a. Default a => a
def

    let _statusBar :: StatusBar
_statusBar = StatusBar :: Widget -> Label -> Label -> Label -> StatusBar
StatusBar
            { _statusBarParent :: Widget
_statusBarParent     = Container FillLayout -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget Container FillLayout
container
            , _statusBarTextLeft :: Label
_statusBarTextLeft   = Label
left
            , _statusBarTextCenter :: Label
_statusBarTextCenter = Label
center
            , _statusBarTextRight :: Label
_statusBarTextRight  = Label
right
            }

    let statusBar :: StatusBar
statusBar = StatusBar -> State VirtualWidget () -> StatusBar
forall w. WidgetClass w => w -> State VirtualWidget () -> w
overrideWidget StatusBar
_statusBar (State VirtualWidget () -> StatusBar)
-> State VirtualWidget () -> StatusBar
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
"statusbar"

    StatusBar
statusBar StatusBar -> Label -> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w v u.
(WidgetClass w, WidgetClass v) =>
w -> v -> UIApp u ()
`connectColorsTo` Label
left

    StatusBar
statusBar StatusBar -> Label -> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w v u.
(WidgetClass w, WidgetClass v) =>
w -> v -> UIApp u ()
`connectColorsTo` Label
center

    StatusBar
statusBar StatusBar -> Label -> ReaderT (AppConfig u) (StateT AppState IO) ()
forall w v u.
(WidgetClass w, WidgetClass v) =>
w -> v -> UIApp u ()
`connectColorsTo` Label
right

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

    StatusBar -> UIApp u StatusBar
forall (m :: * -> *) a. Monad m => a -> m a
return StatusBar
statusBar