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

module Simple.UI.Layouts.SingleLayout (
    SingleLayout (..),
    SingleLayoutData (..),
    SingleLayoutClass,
    singleLayoutNew,
    layoutIndex,
    def
) where

import Control.Lens (element, (^?))
import Control.Monad (forM_)
import Data.Default.Class

import Simple.UI.Core.Internal.UIApp
import Simple.UI.Core.Attribute
import Simple.UI.Core.ListenerList
import Simple.UI.Widgets.Container
import Simple.UI.Widgets.Widget

newtype SingleLayout = SingleLayout
    { SingleLayout -> Attribute Int
_singleLayoutIndex :: Attribute Int
    }

data SingleLayoutData = SingleLayoutData

class LayoutClass w => SingleLayoutClass w where
    layoutIndex :: w -> Attribute Int

instance LayoutClass SingleLayout where
    type LayoutData SingleLayout = SingleLayoutData

    layoutDraw :: c SingleLayout -> Drawing -> Int -> Int -> UIApp u ()
layoutDraw (c SingleLayout -> Container SingleLayout
forall (w :: * -> *) a. ContainerClass w => w a -> Container a
castToContainer -> Container SingleLayout
container) Drawing
drawing Int
width Int
height = do
        [(Widget, SingleLayoutData)]
_widgets <- Container SingleLayout
-> (Container SingleLayout
    -> Attribute [(Widget, SingleLayoutData)])
-> ReaderT
     (AppConfig u) (StateT AppState IO) [(Widget, SingleLayoutData)]
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Container SingleLayout
container Container SingleLayout -> Attribute [(Widget, SingleLayoutData)]
forall (w :: * -> *) a.
ContainerClass w =>
w a -> AttributeList (Widget, LayoutData a)
widgets
        [(Widget, SingleLayoutData)]
-> ((Widget, SingleLayoutData) -> UIApp u ()) -> UIApp u ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Widget, SingleLayoutData)]
_widgets (((Widget, SingleLayoutData) -> UIApp u ()) -> UIApp u ())
-> ((Widget, SingleLayoutData) -> UIApp u ()) -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ \(Widget
widget, SingleLayoutData
_) -> Widget -> (Widget -> Attribute Bool) -> Bool -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Widget
widget Widget -> Attribute Bool
forall w. WidgetClass w => w -> Attribute Bool
visible Bool
False

        Maybe Widget
maybeWidget <- Container SingleLayout -> UIApp u (Maybe Widget)
forall u. Container SingleLayout -> UIApp u (Maybe Widget)
singleLayoutWidget Container SingleLayout
container
        case Maybe Widget
maybeWidget of
            Just Widget
widget -> do
                Widget -> (Widget -> Attribute Bool) -> Bool -> UIApp u ()
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> a -> m ()
set Widget
widget Widget -> Attribute Bool
forall w. WidgetClass w => w -> Attribute Bool
visible Bool
True
                Widget
-> (Widget -> ListenerList (Drawing -> Int -> Int -> UIApp' ()))
-> (Drawing, Int, Int)
-> UIApp u ()
forall a b w u.
Fire a b =>
w -> (w -> ListenerList a) -> b -> UIApp u ()
fire Widget
widget Widget -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
draw (Drawing
drawing, Int
width, Int
height)
            Maybe Widget
Nothing     ->
                () -> UIApp u ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

    layoutComputeSize :: c SingleLayout -> UIApp u (Int, Int)
layoutComputeSize (c SingleLayout -> Container SingleLayout
forall (w :: * -> *) a. ContainerClass w => w a -> Container a
castToContainer -> Container SingleLayout
container) = do
        Maybe Widget
maybeWidget <- Container SingleLayout -> UIApp u (Maybe Widget)
forall u. Container SingleLayout -> UIApp u (Maybe Widget)
singleLayoutWidget Container SingleLayout
container
        case Maybe Widget
maybeWidget of
            Just Widget
widget -> Widget -> UIApp u (Int, Int)
forall w u. WidgetClass w => w -> UIApp u (Int, Int)
computeSize Widget
widget
            Maybe Widget
Nothing     -> (Int, Int) -> UIApp u (Int, Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
1, Int
1)

instance SingleLayoutClass SingleLayout where
    layoutIndex :: SingleLayout -> Attribute Int
layoutIndex = SingleLayout -> Attribute Int
_singleLayoutIndex

instance Default SingleLayoutData where
    def :: SingleLayoutData
def = SingleLayoutData
SingleLayoutData

singleLayoutNew :: UIApp u SingleLayout
singleLayoutNew :: UIApp u SingleLayout
singleLayoutNew = do
    Attribute Int
index <- Int -> ReaderT (AppConfig u) (StateT AppState IO) (Attribute Int)
forall (m :: * -> *) a. MonadIO m => a -> m (Attribute a)
attributeNew Int
0
    SingleLayout -> UIApp u SingleLayout
forall (m :: * -> *) a. Monad m => a -> m a
return SingleLayout :: Attribute Int -> SingleLayout
SingleLayout
        { _singleLayoutIndex :: Attribute Int
_singleLayoutIndex = Attribute Int
index
        }

singleLayoutWidget :: Container SingleLayout -> UIApp u (Maybe Widget)
singleLayoutWidget :: Container SingleLayout -> UIApp u (Maybe Widget)
singleLayoutWidget Container SingleLayout
container = do
    [(Widget, SingleLayoutData)]
_widgets <- Container SingleLayout
-> (Container SingleLayout
    -> Attribute [(Widget, SingleLayoutData)])
-> ReaderT
     (AppConfig u) (StateT AppState IO) [(Widget, SingleLayoutData)]
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Container SingleLayout
container Container SingleLayout -> Attribute [(Widget, SingleLayoutData)]
forall (w :: * -> *) a.
ContainerClass w =>
w a -> AttributeList (Widget, LayoutData a)
widgets
    if [(Widget, SingleLayoutData)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Widget, SingleLayoutData)]
_widgets
        then
            Maybe Widget -> UIApp u (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Widget
forall a. Maybe a
Nothing
        else do
            SingleLayout
_layout <- Container SingleLayout
-> (Container SingleLayout -> Attribute SingleLayout)
-> ReaderT (AppConfig u) (StateT AppState IO) SingleLayout
forall (m :: * -> *) s a.
MonadIO m =>
s -> (s -> Attribute a) -> m a
get Container SingleLayout
container Container SingleLayout -> Attribute SingleLayout
forall (w :: * -> *) a. ContainerClass w => w a -> Attribute a
layout
            Int
index <- Attribute Int -> ReaderT (AppConfig u) (StateT AppState IO) Int
forall (m :: * -> *) a. MonadIO m => Attribute a -> m a
readAttr (Attribute Int -> ReaderT (AppConfig u) (StateT AppState IO) Int)
-> Attribute Int -> ReaderT (AppConfig u) (StateT AppState IO) Int
forall a b. (a -> b) -> a -> b
$ SingleLayout -> Attribute Int
forall w. SingleLayoutClass w => w -> Attribute Int
layoutIndex SingleLayout
_layout
            Maybe Widget -> UIApp u (Maybe Widget)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Widget -> UIApp u (Maybe Widget))
-> Maybe Widget -> UIApp u (Maybe Widget)
forall a b. (a -> b) -> a -> b
$ (Widget, SingleLayoutData) -> Widget
forall a b. (a, b) -> a
fst ((Widget, SingleLayoutData) -> Widget)
-> Maybe (Widget, SingleLayoutData) -> Maybe Widget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Widget, SingleLayoutData)]
_widgets [(Widget, SingleLayoutData)]
-> Getting
     (First (Widget, SingleLayoutData))
     [(Widget, SingleLayoutData)]
     (Widget, SingleLayoutData)
-> Maybe (Widget, SingleLayoutData)
forall s a. s -> Getting (First a) s a -> Maybe a
^? Int
-> IndexedTraversal'
     Int [(Widget, SingleLayoutData)] (Widget, SingleLayoutData)
forall (t :: * -> *) a.
Traversable t =>
Int -> IndexedTraversal' Int (t a) a
element Int
index