{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2016 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.Window (
    WindowType (..),
    Window,
    WindowClass,
    castToWindow,
    windowNew,
    windowType,
    windowFocus
) where

import           Control.Lens                  (makeLensesFor, (.=))
import           Simple.UI.Core.Internal.UIApp

import           Simple.UI.Core.Attribute
import           Simple.UI.Widgets.Container
import           Simple.UI.Widgets.Widget

data WindowType = WindowTypeTopLevel
                | WindowTypeDialog
                  deriving (WindowType -> WindowType -> Bool
(WindowType -> WindowType -> Bool)
-> (WindowType -> WindowType -> Bool) -> Eq WindowType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WindowType -> WindowType -> Bool
$c/= :: WindowType -> WindowType -> Bool
== :: WindowType -> WindowType -> Bool
$c== :: WindowType -> WindowType -> Bool
Eq, Int -> WindowType -> ShowS
[WindowType] -> ShowS
WindowType -> String
(Int -> WindowType -> ShowS)
-> (WindowType -> String)
-> ([WindowType] -> ShowS)
-> Show WindowType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WindowType] -> ShowS
$cshowList :: [WindowType] -> ShowS
show :: WindowType -> String
$cshow :: WindowType -> String
showsPrec :: Int -> WindowType -> ShowS
$cshowsPrec :: Int -> WindowType -> ShowS
Show)

data Window a = Window
    { Window a -> Container a
_windowParent :: Container a
    , Window a -> WindowType
_windowType   :: WindowType
    , Window a -> Attribute Bool
_windowFocus  :: Attribute Bool
    }

makeLensesFor [("_windowParent", "windowParent")] ''Window

class ContainerClass w => WindowClass w where
    castToWindow :: w a -> Window a

    windowType :: WindowClass w => w a -> WindowType
    windowType = Window a -> WindowType
forall a. Window a -> WindowType
_windowType (Window a -> WindowType) -> (w a -> Window a) -> w a -> WindowType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w a -> Window a
forall (w :: * -> *) a. WindowClass w => w a -> Window a
castToWindow

    windowFocus :: WindowClass w => w a -> Attribute Bool
    windowFocus = Window a -> Attribute Bool
forall a. Window a -> Attribute Bool
_windowFocus (Window a -> Attribute Bool)
-> (w a -> Window a) -> w a -> Attribute Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. w a -> Window a
forall (w :: * -> *) a. WindowClass w => w a -> Window a
castToWindow

instance WindowClass Window where
    castToWindow :: Window a -> Window a
castToWindow = Window a -> Window a
forall a. a -> a
id

instance ContainerClass Window where
    castToContainer :: Window a -> Container a
castToContainer = Window a -> Container a
forall a. Window a -> Container a
_windowParent

instance WidgetClass (Window a) where
    castToWidget :: Window a -> Widget
castToWidget = Container a -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget (Container a -> Widget)
-> (Window a -> Container a) -> Window a -> Widget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Window a -> Container a
forall (w :: * -> *) a. ContainerClass w => w a -> Container a
castToContainer

    overrideWidget :: Window a -> State VirtualWidget () -> Window a
overrideWidget = Lens' (Window a) (Container a)
-> Window a -> State VirtualWidget () -> Window a
forall p w.
WidgetClass p =>
Lens' w p -> w -> State VirtualWidget () -> w
overrideWidgetHelper forall a a. Lens (Window a) (Window a) (Container a) (Container a)
Lens' (Window a) (Container a)
windowParent

windowNew :: LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNew :: WindowType -> a -> UIApp u (Window a)
windowNew = WindowType -> a -> UIApp u (Window a)
forall a u. LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNewOverride

windowNewOverride :: LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNewOverride :: WindowType -> a -> UIApp u (Window a)
windowNewOverride WindowType
t a
_layout = Window a -> Window a
forall w. WidgetClass w => w -> w
override (Window a -> Window a) -> UIApp u (Window a) -> UIApp u (Window a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WindowType -> a -> UIApp u (Window a)
forall a u. LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNewDefault WindowType
t a
_layout
  where
    override :: w -> w
override w
window = w -> State VirtualWidget () -> w
forall w. WidgetClass w => w -> State VirtualWidget () -> w
overrideWidget w
window (State VirtualWidget () -> w) -> State VirtualWidget () -> w
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
"window"

windowNewDefault :: LayoutClass a => WindowType -> a -> UIApp u (Window a)
windowNewDefault :: WindowType -> a -> UIApp u (Window a)
windowNewDefault WindowType
t a
_layout = do
    Container a
parent <- a -> UIApp u (Container a)
forall a u. LayoutClass a => a -> UIApp u (Container a)
containerNew a
_layout
    Attribute Bool
focusLens <- Bool -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Bool)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Bool
False

    Window a -> UIApp u (Window a)
forall (m :: * -> *) a. Monad m => a -> m a
return Window :: forall a. Container a -> WindowType -> Attribute Bool -> Window a
Window
        { _windowParent :: Container a
_windowParent = Container a
parent
        , _windowType :: WindowType
_windowType = WindowType
t
        , _windowFocus :: Attribute Bool
_windowFocus = Attribute Bool
focusLens
        }